From 299e2c41124d3fa8adba7244716515a2cc160ed1 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Fri, 14 Oct 2016 21:12:21 +0200 Subject: [PATCH] unres_package_Oct_2016 from emilial --- examples/MD_FG2/Berendsen/ff_1l2y/1L2Y_MD.inp | 15 + examples/MD_FG2/Berendsen/ff_1l2y/startF90.mat | 43 + examples/MD_FG2/Berendsen/ff_gab/1L2Y_MD.inp | 15 + examples/MD_FG2/Berendsen/ff_gab/startF90.mat | 40 + source/cluster/Makefile | 166 ++ source/cluster/Makefile_old | 242 ++ source/cluster/clust_data.f90 | 74 + source/cluster/cluster.f90 | 664 +++++ source/cluster/hc.f90 | 511 ++++ source/cluster/io_clust.f90 | 1824 ++++++++++++ source/cluster/main_clust.F | 449 +++ source/cluster/probabl.f90 | 361 +++ source/cluster/proc_proc.c | 140 + source/cluster/track.f90 | 306 ++ source/cluster/xdrf | 1 + source/unres/CSA.f90 | 5 +- source/unres/CSA_data.f90 | 77 - source/unres/MCM_MD.f90 | 18 + source/unres/MCM_data.f90 | 73 - source/unres/MD.f90 | 38 +- source/unres/MD_data.f90 | 100 - source/unres/MPI_data.f90 | 54 - source/unres/MREMD.f90 | 50 +- source/unres/Makefile | 135 +- source/unres/Makefile_MPICH_ifort_flags | 214 ++ source/unres/Makefile_MPICH_ifort_gCACB | 214 ++ source/unres/Makefile_MPICH_ifort_opt3 | 214 ++ source/unres/Makefile_final | 218 ++ source/unres/Makefile_old | 219 ++ source/unres/REMD.f90 | 4 +- source/unres/REMD_data.f90 | 26 - source/unres/calc_data.f90 | 14 - source/unres/cinfo.f90 | 29 +- source/unres/comm_local.f90 | 102 - source/unres/compare.f90 | 36 +- source/unres/compare_data.f90 | 50 - source/unres/control.f90 | 231 +- source/unres/control_data.f90 | 76 - source/unres/data/CSA_data.f90 | 77 + source/unres/data/MCM_data.f90 | 73 + source/unres/data/MD_data.f90 | 100 + source/unres/data/MPI_data.f90 | 54 + source/unres/data/REMD_data.f90 | 26 + source/unres/data/calc_data.f90 | 14 + source/unres/data/comm_local.f90 | 103 + source/unres/data/compare_data.f90 | 51 + source/unres/data/control_data.f90 | 92 + source/unres/data/energy_data.f90 | 278 ++ source/unres/data/geometry_data.f90 | 60 + source/unres/data/io_units.f90 | 71 + source/unres/data/map_data.f90 | 10 + source/unres/data/minim_data.f90 | 13 + source/unres/data/names.f90 | 66 + source/unres/energy.f90 | 545 ++-- source/unres/energy_data.f90 | 275 -- source/unres/geometry.f90 | 90 +- source/unres/geometry_data.f90 | 60 - source/unres/io.f90 | 67 +- source/unres/io_base.f90 | 120 +- source/unres/io_config.f90 | 446 ++- source/unres/io_units.f90 | 63 - source/unres/map.f90 | 2 +- source/unres/map_data.f90 | 10 - source/unres/md_calc.f90 | 2 + source/unres/minim.f90 | 13 +- source/unres/minim_data.f90 | 13 - source/unres/muca_md.f90 | 2 - source/unres/names.f90 | 66 - source/unres/prng.f90 | 10 +- source/unres/prng_32.f90 | 34 +- source/unres/random.f90 | 29 +- source/unres/regularize.f90 | 6 +- source/unres/unres.f90 | 47 +- source/unres/xdrf | 1 + source/wham/Makefile | 181 ++ source/wham/Makefile_old | 236 ++ source/wham/cinfo.f90 | 38 + source/wham/compinfo.c | 82 + source/wham/conform_compar.f90 | 3559 ++++++++++++++++++++++++ source/wham/control_wham.f90 | 290 ++ source/wham/enecalc.f90 | 1708 ++++++++++++ source/wham/io_database.f90 | 1488 ++++++++++ source/wham/io_wham.f90 | 2764 ++++++++++++++++++ source/wham/proc_proc.c | 140 + source/wham/w_comm_local.f90 | 9 + source/wham/w_compar_data.f90 | 55 + source/wham/wham.f90 | 372 +++ source/wham/wham_calc.f90 | 1259 +++++++++ source/wham/wham_data.f90 | 132 + source/wham/work_partition.f90 | 127 + source/wham/xdrf | 1 + 91 files changed, 20678 insertions(+), 1800 deletions(-) create mode 100644 examples/MD_FG2/Berendsen/ff_1l2y/1L2Y_MD.inp create mode 100755 examples/MD_FG2/Berendsen/ff_1l2y/startF90.mat create mode 100644 examples/MD_FG2/Berendsen/ff_gab/1L2Y_MD.inp create mode 100755 examples/MD_FG2/Berendsen/ff_gab/startF90.mat create mode 100644 source/cluster/Makefile create mode 100644 source/cluster/Makefile_old create mode 100644 source/cluster/clust_data.f90 create mode 100644 source/cluster/cluster.f90 create mode 100644 source/cluster/hc.f90 create mode 100644 source/cluster/io_clust.f90 create mode 100644 source/cluster/main_clust.F create mode 100644 source/cluster/probabl.f90 create mode 100644 source/cluster/proc_proc.c create mode 100644 source/cluster/track.f90 create mode 120000 source/cluster/xdrf delete mode 100644 source/unres/CSA_data.f90 delete mode 100644 source/unres/MCM_data.f90 delete mode 100644 source/unres/MD_data.f90 delete mode 100644 source/unres/MPI_data.f90 create mode 100644 source/unres/Makefile_MPICH_ifort_flags create mode 100644 source/unres/Makefile_MPICH_ifort_gCACB create mode 100644 source/unres/Makefile_MPICH_ifort_opt3 create mode 100644 source/unres/Makefile_final create mode 100644 source/unres/Makefile_old delete mode 100644 source/unres/REMD_data.f90 delete mode 100644 source/unres/calc_data.f90 delete mode 100644 source/unres/comm_local.f90 delete mode 100644 source/unres/compare_data.f90 delete mode 100644 source/unres/control_data.f90 create mode 100644 source/unres/data/CSA_data.f90 create mode 100644 source/unres/data/MCM_data.f90 create mode 100644 source/unres/data/MD_data.f90 create mode 100644 source/unres/data/MPI_data.f90 create mode 100644 source/unres/data/REMD_data.f90 create mode 100644 source/unres/data/calc_data.f90 create mode 100644 source/unres/data/comm_local.f90 create mode 100644 source/unres/data/compare_data.f90 create mode 100644 source/unres/data/control_data.f90 create mode 100644 source/unres/data/energy_data.f90 create mode 100644 source/unres/data/geometry_data.f90 create mode 100644 source/unres/data/io_units.f90 create mode 100644 source/unres/data/map_data.f90 create mode 100644 source/unres/data/minim_data.f90 create mode 100644 source/unres/data/names.f90 delete mode 100644 source/unres/energy_data.f90 delete mode 100644 source/unres/geometry_data.f90 delete mode 100644 source/unres/io_units.f90 delete mode 100644 source/unres/map_data.f90 delete mode 100644 source/unres/minim_data.f90 delete mode 100644 source/unres/names.f90 create mode 120000 source/unres/xdrf create mode 100644 source/wham/Makefile create mode 100644 source/wham/Makefile_old create mode 100644 source/wham/cinfo.f90 create mode 100644 source/wham/compinfo.c create mode 100644 source/wham/conform_compar.f90 create mode 100644 source/wham/control_wham.f90 create mode 100644 source/wham/enecalc.f90 create mode 100644 source/wham/io_database.f90 create mode 100644 source/wham/io_wham.f90 create mode 100644 source/wham/proc_proc.c create mode 100644 source/wham/w_comm_local.f90 create mode 100644 source/wham/w_compar_data.f90 create mode 100644 source/wham/wham.f90 create mode 100644 source/wham/wham_calc.f90 create mode 100644 source/wham/wham_data.f90 create mode 100644 source/wham/work_partition.f90 create mode 120000 source/wham/xdrf diff --git a/examples/MD_FG2/Berendsen/ff_1l2y/1L2Y_MD.inp b/examples/MD_FG2/Berendsen/ff_1l2y/1L2Y_MD.inp new file mode 100644 index 0000000..65a5742 --- /dev/null +++ b/examples/MD_FG2/Berendsen/ff_1l2y/1L2Y_MD.inp @@ -0,0 +1,15 @@ +1L2Y with Berendsen thermostat in ff_1l2y MD simulation +SEED=-3059743 PDBREF MD EXTCONF RESCALE_MODE=2 RESPA +nstep=1000000 ntwe=10000 ntwx=10000 dt=0.20 damax=10.0 lang=0 tbf & +tau_bath=1.0 t_bath=300 reset_vel=10000 respa ntime_split=1 maxtime_split=512 +WLONG=1.00000 WSCP=1.23315 WELEC=0.84476 WBOND=1.00000 WANG=0.62954 & +WSCLOC=0.10554 WTOR=1.84316 WTORD=1.26571 WCORRH=0.19212 WCORR5=0.00000 & +WCORR6=0.00000 WEL_LOC=0.37357 WTURN3=1.40323 WTURN4=0.64673 WTURN6=0.00000 & +WVDWPP=0.23173 WHPB=1.00000 WSCCOR=0.0 & +CUTOFF=7.00000 WCORR4=0.00000 +../../../1L2Y.pdb +22 + D ASN LEU TYR ILE GLN TRP LEU LYS ASP GLY GLY PRO SER SER GLY ARG PRO PRO PRO + SER D + 0 + 0 diff --git a/examples/MD_FG2/Berendsen/ff_1l2y/startF90.mat b/examples/MD_FG2/Berendsen/ff_1l2y/startF90.mat new file mode 100755 index 0000000..625dac9 --- /dev/null +++ b/examples/MD_FG2/Berendsen/ff_1l2y/startF90.mat @@ -0,0 +1,43 @@ +#PBS -N test_MD +#PBS -q nowy +#PBS -l nodes=2:ppn=4 +#PBS -l walltime=8:00:00 + +setenv FGPROCS 2 +setenv POT GB +#ssetenv PREFIX min_UNRES +#setenv PREFIX 1L2Y_min-rand-oneletter +#setenv PREFIX 1L2Y_min-rand +#setenv PREFIX 1L2Y_min-fulloutput +#setenv PREFIX 1L2Y_checkgrad0 +#setenv PREFIX 1L2Y_ene +setenv PREFIX 1L2Y_MD +setenv OUT1FILE YES +#----------------------------------------------------------------------------- +setenv UNRES_BIN /users2/emilial/unres_package_Oct_2016/bin/unres_E0LL2Y_F90_EL.exe +#---------------------------------------------------------------------- +setenv DD /users/emilial/unres_devel/unres_MD-M/PARAM +#setenv DD /users/aks255/newUNRES/unres/PARAM +setenv BONDPAR $DD/bond_AM1_ext.parm +setenv THETPARPDB $DD/thetaml_ext.5parm +setenv THETPAR $DD/pot_theta_G631_DIL_ext.parm +setenv ROTPARPDB $DD/scgauss_ext.parm +setenv ROTPAR $DD/rotamers_AM1_aura_ext.10022007.parm +setenv TORPAR $DD/pot_tor_G631_DIL_ext.parm +setenv TORDPAR $DD/pot_tord_G631_DIL_ext.parm +setenv ELEPAR $DD/electr_631Gdp_ext.parm +setenv SIDEPAR $DD/scinter_${POT}_ext.parm +#setenv SIDEPAR $DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k +setenv FOURIER $DD/fourier_opt_ext.parm.1igd_hc_iter3_3 +#setenv FOURIER fourier_opt.parm.1e0l_1enh_PAR5-Sq2-14-ufree_q14sig_shan1e9-a03 +#setenv SCCORPAR /users/pk376/unres-git2/unres/PARAM/sccor_am1_pawel_ext.dat +setenv SCCORPAR $DD/sccor_am1_pawel_ext.dat +setenv SCPPAR $DD/scp_ext.parm +setenv PATTERN $DD/patterns.cart +#---------------------------------------------------------------------- + +setenv MPIRUN "/users/software/mpich2-1.4.1p1_intel/bin/mpirun" +setenv NPROCS `cat $PBS_NODEFILE | wc -l` + +cd $PBS_O_WORKDIR +$MPIRUN -machinefile $PBS_NODEFILE -np $NPROCS $UNRES_BIN diff --git a/examples/MD_FG2/Berendsen/ff_gab/1L2Y_MD.inp b/examples/MD_FG2/Berendsen/ff_gab/1L2Y_MD.inp new file mode 100644 index 0000000..ded0361 --- /dev/null +++ b/examples/MD_FG2/Berendsen/ff_gab/1L2Y_MD.inp @@ -0,0 +1,15 @@ +1L2Y with Berendsen thermostat in ff_gab MD simulation +SEED=-3059743 PDBREF MD EXTCONF RESCALE_MODE=2 +nstep=1000000 ntwe=10000 ntwx=10000 dt=0.20 damax=10.0 lang=0 tbf & +tau_bath=1.0 t_bath=300 reset_vel=10000 respa ntime_split=1 maxtime_split=512 +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 WSCCOR=0.0 +../../../1L2Y.pdb +22 + D ASN LEU TYR ILE GLN TRP LEU LYS ASP GLY GLY PRO SER SER GLY ARG PRO PRO PRO + SER D + 0 + 0 diff --git a/examples/MD_FG2/Berendsen/ff_gab/startF90.mat b/examples/MD_FG2/Berendsen/ff_gab/startF90.mat new file mode 100755 index 0000000..81b05a5 --- /dev/null +++ b/examples/MD_FG2/Berendsen/ff_gab/startF90.mat @@ -0,0 +1,40 @@ +#PBS -N test_MD +#PBS -q nowy +#PBS -l nodes=2:ppn=4 +#PBS -l walltime=8:00:00 + +setenv FGPROCS 2 +setenv POT GB +#ssetenv PREFIX min_UNRES +#setenv PREFIX 1L2Y_min-rand-oneletter +#setenv PREFIX 1L2Y_min-rand +#setenv PREFIX 1L2Y_min-fulloutput +#setenv PREFIX 1L2Y_checkgrad0 +#setenv PREFIX 1L2Y_ene +setenv PREFIX 1L2Y_MD +setenv OUT1FILE YES +#----------------------------------------------------------------------------- +setenv UNRES_BIN /users2/emilial/unres_package_Oct_2016/bin/unres_GAB_F90_EL.exe +#---------------------------------------------------------------------- +setenv DD /users2/emilial/unres_devel/unres_MD-M/PARAM +#setenv DD /users/czarek/UNRES/GIT/unres/PARAM +setenv BONDPAR $DD/bond_ext.parm +setenv THETPAR $DD/thetaml_ext.5parm +setenv ROTPAR $DD/scgauss_ext.parm +setenv TORPAR $DD/pot_tor_G631_DIL_ext.parm +setenv TORDPAR $DD/pot_tord_G631_DIL_ext.parm +setenv ELEPAR $DD/electr_631Gdp_ext.parm +setenv SIDEPAR $DD/sc_GB_opt_ext.1gab_3S_qclass5no310-shan2-sc-16-10-8k +setenv FOURIER $DD/fourier_opt_ext.parm.1igd_hc_iter3_3 +setenv SCCORPAR $DD/sccor_pdb_shelly_ext.dat +setenv SCPPAR $DD/scp_ext.parm +setenv PATTERN $DD/patterns.cart +setenv PRINT_PARM NO +#----------------------------------------------------------------------------- + +setenv MPIRUN "/users/software/mpich2-1.4.1p1_intel/bin/mpirun" +setenv NPROCS `cat $PBS_NODEFILE | wc -l` + +cd $PBS_O_WORKDIR +$MPIRUN -machinefile $PBS_NODEFILE -np $NPROCS $UNRES_BIN + diff --git a/source/cluster/Makefile b/source/cluster/Makefile new file mode 100644 index 0000000..3e22cd8 --- /dev/null +++ b/source/cluster/Makefile @@ -0,0 +1,166 @@ +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +#BIN=../bin +#FC = ifort +FC= ${INSTALL_DIR}/bin/mpif90 +OPT = -O3 -ip -w +DEB = -g -CA -CB -check pointer #-check uninit +#OPT = -O3 #-ip +FFLAGS = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS2 = -fpp -c -g -CA -CB #-O0 +#OPT = -CB -g +#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 + +#.c.o: +# cc -c -DLINUX -DPGI $*.c + +#.f.o: +# ${FC} ${FFLAGS} $*.f + +#.F.o: +# ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F +#UNRES_FILE= ../../UNRESS/unres_f90/source/unres_MD-M +UNRES_FILE= ../unres_MD-M +UNRES_DATA_FILE= ../unres_MD-M/data +WHAM_FILE= ../wham + +data = clust_data.o +#w_compar_data.o w_comm_local.o + +data_unres = names.o io_units.o control_data.o calc_data.o \ + compare_data.o control_data.o minim_data.o MD_data.o\ + energy_data.o geometry_data.o MPI_data.o MCM_data.o comm_local.o + +objects_unres = xdrf/*.o math.o geometry.o \ + io_base.o energy.o regularize.o control.o io_config.o + + +#compare_data.o control_data.o minim_data.o CSA_data.o +objects_wham = wham_data.o conform_compar.o io_wham.o work_partition.o + +objects = track.o hc.o io_clust.o probabl.o cluster.o + +all: no_option + @echo "Specify force field: GAB or E0LL2Y" + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DCLUSTER +GAB: EXE_FILE = ../../bin/cluster_GAB_F90_EL.exe +GAB: ${data} ${data_unres} ${objects_unres} ${objects_wham} ${objects} + $(FC) ${OPT} ${data} ${data_unres} ${objects_unres} ${objects_wham} ${objects} -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD-mult_MPICH-GAB.exe + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCLUSTER +E0LL2Y: EXE_FILE = ../../bin/cluster_E0LL2Y_F90_EL.exe +E0LL2Y: ${data} ${data_unres} ${objects_unres} ${objects_wham} ${objects} + $(FC) ${OPT} ${data} ${data_unres} ${objects_unres} ${objects_wham} ${objects} -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD-mult_MPICH-E0LL2Y.exe + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm -f compinfo && cd xdrf && make clean +# rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +clust_data.o: clust_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} clust_data.f90 + +wham_data.o: ${WHAM_FILE}/wham_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/wham_data.f90 + + +names.o: ${UNRES_DATA_FILE}/names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/names.f90 + +io_units.o: ${UNRES_DATA_FILE}/io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/io_units.f90 + +calc_data.o: ${UNRES_DATA_FILE}/calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/calc_data.f90 + +compare_data.o: ${UNRES_DATA_FILE}/compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/compare_data.f90 + +control_data.o: ${UNRES_DATA_FILE}/control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/control_data.f90 + +energy_data.o: ${UNRES_DATA_FILE}/energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/energy_data.f90 + +geometry_data.o: ${UNRES_DATA_FILE}/geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/geometry_data.f90 + +map_data.o: ${UNRES_DATA_FILE}/map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/map_data.f90 + +MCM_data.o: ${UNRES_DATA_FILE}/MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/MCM_data.f90 + +MD_data.o: ${UNRES_DATA_FILE}/MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/MD_data.f90 + +minim_data.o: ${UNRES_DATA_FILE}/minim_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/minim_data.f90 + +MPI_data.o: ${UNRES_DATA_FILE}/MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/MPI_data.f90 + +comm_local.o: ${UNRES_DATA_FILE}/comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/comm_local.f90 + +math.o: ${UNRES_FILE}/math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/math.f90 + +geometry.o: ${UNRES_FILE}/geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/geometry.f90 + +io_base.o: ${UNRES_FILE}/io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io_base.f90 + +energy.o: ${UNRES_FILE}/energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/energy.f90 + +control.o: ${UNRES_FILE}/control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/control.f90 + +io_config.o: ${UNRES_FILE}/io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} ${UNRES_FILE}/io_config.f90 + +regularize.o: ${UNRES_FILE}/regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/regularize.f90 + + +proc_proc.o: proc_proc.c + ${CC} ${CPPFLAGS} -O -c proc_proc.c + +io_wham.o: ${WHAM_FILE}/io_wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/io_wham.f90 + +conform_compar.o: ${WHAM_FILE}/conform_compar.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/conform_compar.f90 + +work_partition.o: ${WHAM_FILE}/work_partition.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/work_partition.f90 + +probabl.o: probabl.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} probabl.f90 + +track.o: track.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} track.f90 + +hc.o: hc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} hc.f90 + +io_clust.o: io_clust.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_clust.f90 + +cluster.o: cluster.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} cluster.f90 diff --git a/source/cluster/Makefile_old b/source/cluster/Makefile_old new file mode 100644 index 0000000..6006cd1 --- /dev/null +++ b/source/cluster/Makefile_old @@ -0,0 +1,242 @@ +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +#BIN=../bin +#FC = ifort +FC= ${INSTALL_DIR}/bin/mpif90 +OPT = -O3 -ip -w +DEB = -g -CA -CB -check pointer #-check uninit +#OPT = -O3 #-ip +FFLAGS = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS2 = -fpp -c -g -CA -CB #-O0 +#OPT = -CB -g +#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 + +#.c.o: +# cc -c -DLINUX -DPGI $*.c + +#.f.o: +# ${FC} ${FFLAGS} $*.f + +#.F.o: +# ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F +#UNRES_FILE= ../../UNRESS/unres_f90/source/unres_MD-M +UNRES_FILE= ../unres_MD-M +WHAM_FILE= ../wham + +data = clust_data.o +#w_compar_data.o w_comm_local.o + +objects_unres = xdrf/*.o names.o io_units.o control_data.o calc_data.o \ + compare_data.o control_data.o minim_data.o MD_data.o\ + energy_data.o geometry_data.o MPI_data.o MCM_data.o comm_local.o math.o geometry.o \ + io_base.o energy.o regularize.o control.o io_config.o # compare.o + +#compare_data.o control_data.o minim_data.o CSA_data.o +objects_wham = wham_data.o conform_compar.o io_wham.o work_partition.o + +objects = track.o hc.o io_clust.o probabl.o cluster.o + +all: no_option + @echo "Specify force field: GAB or E0LL2Y" + +no_option: + + +#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 + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DCLUSTER +GAB: EXE_FILE = ../../bin/cluster_GAB_F90_EL.exe +GAB: ${data} ${objects_unres} ${objects_wham} ${objects} + $(FC) ${OPT} ${data} ${objects_unres} ${objects_wham} ${objects} -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD-mult_MPICH-GAB.exe + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCLUSTER +E0LL2Y: EXE_FILE = ../../bin/cluster_E0LL2Y_F90_EL.exe +E0LL2Y: ${data} ${objects_unres} ${objects_wham} ${objects} + $(FC) ${OPT} ${data} ${objects_unres} ${objects_wham} ${objects} -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD-mult_MPICH-E0LL2Y.exe + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm -f compinfo && cd xdrf && make clean +# rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +clust_data.o: clust_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} clust_data.f90 + +wham_data.o: ${WHAM_FILE}/wham_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/wham_data.f90 + +w_compar_data.o: w_compar_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} w_compar_data.f90 + +w_comm_local.o: w_comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} w_comm_local.f90 + + +names.o: ${UNRES_FILE}/names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/names.f90 + +io_units.o: ${UNRES_FILE}/io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io_units.f90 + +calc_data.o: ${UNRES_FILE}/calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/calc_data.f90 + +compare_data.o: ${UNRES_FILE}/compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/compare_data.f90 + +control_data.o: ${UNRES_FILE}/control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/control_data.f90 + +CSA_data.o: ${UNRES_FILE}/CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/CSA_data.f90 + +energy_data.o: ${UNRES_FILE}/energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/energy_data.f90 + +geometry_data.o: ${UNRES_FILE}/geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/geometry_data.f90 + +map_data.o: ${UNRES_FILE}/map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/map_data.f90 + +MCM_data.o: ${UNRES_FILE}/MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MCM_data.f90 + +MD_data.o: ${UNRES_FILE}/MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MD_data.f90 + +minim_data.o: ${UNRES_FILE}/minim_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/minim_data.f90 + +MPI_data.o: ${UNRES_FILE}/MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MPI_data.f90 + +REMD_data.o: ${UNRES_FILE}/REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/REMD_data.f90 + +comm_local.o: ${UNRES_FILE}/comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/comm_local.f90 + +prng_32.o: ${UNRES_FILE}/prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/prng_32.f90 + +math.o: ${UNRES_FILE}/math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/math.f90 + +random.o: ${UNRES_FILE}/random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/random.f90 + +geometry.o: ${UNRES_FILE}/geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/geometry.f90 + +md_calc.o: ${UNRES_FILE}/md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} ${UNRES_FILE}/md_calc.f90 + +io_base.o: ${UNRES_FILE}/io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io_base.f90 + +energy.o: ${UNRES_FILE}/energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/energy.f90 + +check_bond.o: ${UNRES_FILE}/check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/check_bond.f90 + +control.o: ${UNRES_FILE}/control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/control.f90 + +io_config.o: ${UNRES_FILE}/io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} ${UNRES_FILE}/io_config.f90 + +MPI.o: ${UNRES_FILE}/MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MPI.f90 + +minim.o: ${UNRES_FILE}/minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} ${UNRES_FILE}/minim.f90 + +regularize.o: ${UNRES_FILE}/regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/regularize.f90 + +compare.o: ${UNRES_FILE}/compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/compare.f90 + +map.o: ${UNRES_FILE}/map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/map.f90 + +muca_md.o: ${UNRES_FILE}/muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/muca_md.f90 + +REMD.o: ${UNRES_FILE}/REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/REMD.f90 + +MCM_MD.o: ${UNRES_FILE}/MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MCM_MD.f90 + +io.o: ${UNRES_FILE}/io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io.f90 + +MD.o: ${UNRES_FILE}/MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/MD.f90 + +MREMD.o: ${UNRES_FILE}/MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MREMD.f90 + +CSA.o: ${UNRES_FILE}/CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/CSA.f90 + +unres.o: ${UNRES_FILE}/unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/unres.f90 + + +proc_proc.o: proc_proc.c + ${CC} ${CPPFLAGS} -O -c proc_proc.c + +io_database.o: io_database.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_database.f90 + +io_wham.o: ${WHAM_FILE}/io_wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/io_wham.f90 + +conform_compar.o: ${WHAM_FILE}/conform_compar.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/conform_compar.f90 + +enecalc.o: enecalc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} enecalc.f90 + +wham_calc.o: wham_calc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham_calc.f90 + +work_partition.o: ${WHAM_FILE}/work_partition.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${WHAM_FILE}/work_partition.f90 + +wham.o: wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham.f90 + +probabl.o: probabl.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} probabl.f90 + +track.o: track.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} track.f90 + +hc.o: hc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} hc.f90 + +io_clust.o: io_clust.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_clust.f90 + +cluster.o: cluster.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} cluster.f90 diff --git a/source/cluster/clust_data.f90 b/source/cluster/clust_data.f90 new file mode 100644 index 0000000..7779f93 --- /dev/null +++ b/source/cluster/clust_data.f90 @@ -0,0 +1,74 @@ + module clust_data +!----------------------------------------------------------------------------- +!***************************************************************** +! +! Array dimensions for the clustering programs: +! +! Max. number of conformations in the data set. +! + integer,PARAMETER :: MAXCONF=13000 + integer,parameter :: maxstr_proc=maxconf/2 +! +! Max. number of "distances" between conformations. +! + integer,PARAMETER :: MAXDIST=(maxstr_proc*(maxstr_proc-1))/2 +! +! Max. number of clusters. Should be set to MAXCONF; change only if there are +! problems with memory. In such a case be suspicious about the results, however! +! + integer,PARAMETER :: MAXGR=maxstr_proc +! +! Max. number of conformations in a cluster. Remark above applies also here. +! + integer,PARAMETER :: MAXINGR=maxstr_proc +! +! Max. number of cut-off values +! + integer,PARAMETER :: MAX_CUT=5 +! +! Max. number of properties +! + integer,PARAMETER :: MAXPROP=5 +! +! Max. number of temperatures + integer,parameter :: maxT=5 +! +! Max. number of S-S bridges + integer,parameter :: maxss=20 +! +!****************************************************************** +!COMMON.CLUSTER +! common /clu/ + real(kind=4),dimension(:),allocatable :: diss !(maxdist) + real(kind=8),dimension(:),allocatable :: energy,totfree !(0:maxconf) + real(kind=8),dimension(:,:),allocatable :: enetb !(max_ene,maxstr_proc) + real(kind=8),dimension(:),allocatable :: entfac !(maxconf) + real(kind=8),dimension(:),allocatable :: totfree_gr !(maxgr) + real(kind=8),dimension(:),allocatable :: rcutoff !(max_cut+1) + real(kind=8) :: ecut + integer :: ncut + logical :: min_var,tree,plot_tree,lgrp +! common /clu1/ + integer,dimension(:),allocatable :: licz,iass !(maxgr) + integer,dimension(:,:),allocatable :: nconf !(maxgr,maxingr) + integer,dimension(:,:),allocatable :: iass_tot !(maxgr,max_cut) + integer,dimension(:),allocatable :: list_conf !(maxconf) + integer :: ngr +! common /alles/ + real(kind=4),dimension(:,:,:),allocatable :: allcart !(3,maxres2,maxstr_proc) + real(kind=8),dimension(:),allocatable :: rmstb !(maxconf) + integer,dimension(:),allocatable :: mult !(maxres) + integer,dimension(:),allocatable :: nss_all !(maxstr_proc) + integer,dimension(:,:),allocatable :: ihpb_all,jhpb_all !(maxss,maxstr_proc) + integer,dimension(:),allocatable :: icc,iscore !(maxconf) + integer :: nprop +!COMMON.TEMPFAC +! common /factemp/ + real(kind=8),dimension(:,:),allocatable :: tempfac !(2,maxres) +!COMMON.FREE +! common /free/ + integer :: nT + real(kind=8) :: prob_limit + real(kind=8),dimension(:),allocatable :: beta_h !(maxT) +!----------------------------------------------------------------------------- + end module clust_data diff --git a/source/cluster/cluster.f90 b/source/cluster/cluster.f90 new file mode 100644 index 0000000..1b6767c --- /dev/null +++ b/source/cluster/cluster.f90 @@ -0,0 +1,664 @@ + program cluster +! +! Program to cluster united-residue MCM results. +! + use clust_data + use probability + use tracking + use hc_ + use io_clust +!#define CLUSTER + use io_units + use io_base, only: permut + use geometry_data, only: nres,theta,phi,alph,omeg,& + c,cref + use energy_data, only: nnt,nct + use control_data, only: symetr,outpdb,outmol2,titel,& + iopt,print_dist,MaxProcs + use control, only: tcpu,initialize + + use wham_data, only: punch_dist + use io_wham, only: parmread + use work_part +! include 'DIMENSIONS' +! include 'sizesclu.dat' +#ifdef MPI + use mpi_data + implicit none + include "mpif.h" + integer :: IERROR,ERRCODE !STATUS(MPI_STATUS_SIZE) +#else + implicit none +! include "COMMON.MPI" +#endif +! include 'COMMON.TIME1' +! include 'COMMON.INTERACT' +! include 'COMMON.NAMES' +! include 'COMMON.GEO' +! include 'COMMON.HEADER' +! include 'COMMON.CONTROL' +! include 'COMMON.CHAIN' +! include 'COMMON.VAR' +! include 'COMMON.CLUSTER' +! include 'COMMON.IOUNITS' +! include 'COMMON.FREE' + + logical,dimension(:),allocatable :: printang !(max_cut) + integer,dimension(:),allocatable :: printpdb !(max_cut) + integer,dimension(:),allocatable :: printmol2 !(max_cut) + character(len=240) lineh + REAL(kind=4),dimension(:),allocatable :: CRIT,MEMBR !(maxconf) + REAL(kind=4),dimension(:),allocatable :: CRITVAL !(maxconf-1) + INTEGER,dimension(:),allocatable :: IA,IB !(maxconf) + INTEGER,dimension(:,:),allocatable :: ICLASS !(maxconf,maxconf-1) + INTEGER,dimension(:),allocatable :: HVALS !(maxconf-1) + INTEGER,dimension(:),allocatable :: IORDER,HEIGHT !(maxconf-1) + integer,dimension(:),allocatable :: nn !(maxconf) + integer :: ndis + real(kind=4),dimension(:),allocatable :: DISNN !(maxconf) + LOGICAL,dimension(:),allocatable :: FLAG !(maxconf) + integer :: i,j,k,l,m,n,len,lev,idum,ii,ind,jj,icut,ncon,& + it,ncon_work,ind1,kkk + real(kind=8) :: t1,t2,difconf + + real(kind=8),dimension(:),allocatable :: varia !(maxvar) + real(kind=8),dimension(:),allocatable :: list_conf_ !(maxvar) + real(kind=8) :: hrtime,mintime,sectime + logical :: eof + external :: difconf +!el + real(kind=4),dimension(:),allocatable :: diss_ !(maxdist) + integer,dimension(:),allocatable :: scount_ !(maxdist) +#ifdef MPI + call MPI_Init( IERROR ) + call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR ) + call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR ) + Master = 0 + if (ierror.gt.0) then + write(iout,*) "SEVERE ERROR - Can't initialize MPI." + call mpi_finalize(ierror) + stop + endif + if (nprocs.gt.MaxProcs+1) then + write (2,*) "Error - too many processors",& + nprocs,MaxProcs+1 + write (2,*) "Increase MaxProcs and recompile" + call MPI_Finalize(IERROR) + stop + endif +#endif +!elwrite(iout,*) "before parmread" + allocate(printang(max_cut)) + allocate(printpdb(max_cut)) + allocate(printmol2(max_cut)) + call initialize +!elwrite(iout,*) "before parmread" + call openunits +!elwrite(iout,*) "before parmread" + call parmread + call read_control +!elwrite(iout,*) "after read control" + call molread +! if (refstr) call read_ref_structure(*30) + do i=1,nres + phi(i)=0.0D0 + theta(i)=0.0D0 + alph(i)=0.0D0 + omeg(i)=0.0D0 + enddo +! write (iout,*) "Before permut" +! write (iout,*) "symetr", symetr +! call flush(iout) + call permut(symetr) +! write (iout,*) "after permut" +! call flush(iout) + print *,'MAIN: nnt=',nnt,' nct=',nct + + DO I=1,NCUT + PRINTANG(I)=.FALSE. + PRINTPDB(I)=0 + printmol2(i)=0 + IF (RCUTOFF(I).LT.0.0) THEN + RCUTOFF(I)=ABS(RCUTOFF(I)) + PRINTANG(I)=.TRUE. + PRINTPDB(I)=outpdb + printmol2(i)=outmol2 + ENDIF + ENDDO + 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 + DO I=1,NRES-3 + MULT(I)=1 + ENDDO + allocate(list_conf(maxconf)) + do i=1,maxconf + list_conf(i)=i + enddo + call read_coords(ncon,*20) + + allocate(list_conf_(maxconf)) + do i=1,maxconf + list_conf_(i)=list_conf(i) + enddo + deallocate(list_conf) + allocate(list_conf(ncon)) + do i=1,ncon + list_conf(i)=list_conf_(i) + enddo + deallocate(list_conf_) + +!el call alloc_clust_arrays(ncon) + + write (iout,*) 'from read_coords: ncon',ncon + + write (iout,*) "nT",nT + do iT=1,nT + write (iout,*) "iT",iT +#ifdef MPI + call work_partition(.true.,ncon) +#endif +!elwrite(iout,*)"after work partition, ncon_work=", ncon_work,ncon + + call probabl(iT,ncon_work,ncon,*20) + +!elwrite(iout,*)"after probabl, ncon_work=", ncon_work,ncon + + if (ncon_work.lt.2) then + write (iout,*) "Too few conformations; clustering skipped" + exit + endif +#ifdef MPI + ndis=ncon_work*(ncon_work-1)/2 + call work_partition(.true.,ndis) +#endif +!el call alloc_clust_arrays(ncon_work) + allocate(ICC(ncon_work)) + allocate(DISS(maxdist)) + + DO I=1,NCON_work + ICC(I)=I + ENDDO + WRITE (iout,'(A80)') TITEL + t1=tcpu() +! +! CALCULATE DISTANCES +! + 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 + 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,kkk)=c(l,k) + enddo + enddo + DO J=I+1,NCON_work + IND=IOFFSET(NCON_work,I,J) +#ifdef MPI + if (ind.ge.indstart(me) .and. ind.le.indend(me)) then +#endif + ind1=ind1+1 + DISS(IND1)=DIFCONF(I,J) +! write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND) +#ifdef MPI + endif +#endif + ENDDO + ENDDO + t2=tcpu() + WRITE (iout,'(/a,1pe14.5,a/)') & + 'Time for distance calculation:',T2-T1,' sec.' + t1=tcpu() + PRINT '(a)','End of distance computation' +!el--------------- + allocate(diss_(maxdist)) + allocate(scount_(0:nprocs)) + + do i=1,maxdist + diss_(i)=diss(i) + enddo + do i=0,nprocs + scount_(i)=scount(i) + enddo +!el----------- +#ifdef MPI + 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 + deallocate(diss_) + deallocate(scount_) + + open(80,file='/tmp/distance',form='unformatted') + do i=1,ndis + write(80) diss(i) + enddo + if (punch_dist) then + do i=1,ncon_work-1 + do j=i+1,ncon_work + IND=IOFFSET(NCON,I,J) + write (jrms,'(2i5,2f10.5)') i,j,diss(IND),& + energy(j)-energy(i) + enddo + enddo + endif +! +! Print out the RMS deviation matrix. +! + if (print_dist) CALL DISTOUT(NCON_work) +! +! call hierarchical clustering HC from F. Murtagh +! + N=NCON_work + LEN = (N*(N-1))/2 + write(iout,*) "-------------------------------------------" + write(iout,*) "HIERARCHICAL CLUSTERING using" + if (iopt.eq.1) then + write(iout,*) "WARD'S MINIMUM VARIANCE METHOD" + elseif (iopt.eq.2) then + write(iout,*) "SINGLE LINK METHOD" + elseif (iopt.eq.3) then + write(iout,*) "COMPLETE LINK METHOD" + elseif (iopt.eq.4) then + write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD" + elseif (iopt.eq.5) then + write(iout,*) "MCQUITTY'S METHOD" + elseif (iopt.eq.6) then + write(iout,*) "MEDIAN (GOWER'S) METHOD" + elseif (iopt.eq.7) then + write(iout,*) "CENTROID METHOD" + else + write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7" + write(*,*) "IOPT=",iopt," IS INVALID, use 1-7" + stop + endif + write(iout,*) + write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching" + write(iout,*) "February 1986" + write(iout,*) "References:" + write(iout,*) "1. Multidimensional clustering algorithms" + write(iout,*) " Fionn Murtagh" + write(iout,*) " Vienna : Physica-Verlag, 1985." + write(iout,*) "2. Multivariate data analysis" + write(iout,*) " Fionn Murtagh and Andre Heck" + write(iout,*) " Kluwer Academic Publishers, 1987" + write(iout,*) "-------------------------------------------" + write(iout,*) + +#ifdef DEBUG + write (iout,*) "The TOTFREE array" + do i=1,ncon_work + write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i) + enddo +#endif + allocate(CRIT(N),MEMBR(N)) !(maxconf) + allocate(CRITVAL(N-1)) !(maxconf-1) + allocate(IA(N),IB(N)) + allocate(ICLASS(N,N-1)) !(maxconf,maxconf-1) + allocate(HVALS(N-1)) !(maxconf-1) + allocate(IORDER(N-1),HEIGHT(N-1)) !(maxconf-1) + allocate(nn(N)) !(maxconf) + allocate(DISNN(N)) !(maxconf) + allocate(FLAG(N)) !(maxconf) + + call flush(iout) + CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS) + LEV = N-1 + write (iout,*) "n",n," ncon_work",ncon_work," lev",lev + if (lev.lt.2) then + write (iout,*) "Too few conformations to cluster." + goto 192 + endif + CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) +! CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL) + + allocate(licz(maxgr)) + allocate(iass(maxgr)) + allocate(nconf(maxgr,maxingr)) + allocate(totfree_gr(maxgr)) + + do i=1,maxgr + licz(i)=0 + enddo + icut=1 + i=1 + NGR=i+1 + do j=1,n + licz(iclass(j,i))=licz(iclass(j,i))+1 + nconf(iclass(j,i),licz(iclass(j,i)))=j +! write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)), +! & nconf(iclass(j,i),licz(iclass(j,i))) + enddo + do i=1,lev-1 + + 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) + write (iout,'(a,f8.2)') 'Maximum distance found:',& + CRITVAL(IDUM) + CALL SRTCLUST(ICUT,ncon_work,iT) + CALL TRACK(ICUT) + CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT) + icut=icut+1 + if (icut.gt.ncut) goto 191 + ENDIF + NGR=i+1 + do l=1,maxgr + licz(l)=0 + enddo + do j=1,n + enddo + do j=1,n + licz(iclass(j,i))=licz(iclass(j,i))+1 + nconf(iclass(j,i),licz(iclass(j,i)))=j +!d write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),& +!d nconf(iclass(j,i),licz(iclass(j,i))) +!d print *,j,iclass(j,i), +!d & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i))) + enddo + enddo + 191 continue +! + if (plot_tree) then + CALL WRITRACK + CALL PLOTREE + endif +! + t2=tcpu() + WRITE (iout,'(/a,1pe14.5,a/)') & + 'Total time for clustering:',T2-T1,' sec.' +#ifdef MPI + endif +#endif + 192 continue + enddo +! + close(icbase,status="delete") +#ifdef MPI +!el call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) +#endif + stop '********** Program terminated normally.' + 20 write (iout,*) "Error reading coordinates" +#ifdef MPI +!el call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) +#endif + stop + 30 write (iout,*) "Error reading reference structure" +#ifdef MPI +!el call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) +#endif + stop + end program cluster +!--------------------------------------------------------------------------- +! +!--------------------------------------------------------------------------- + real(kind=8) function difconf(icon,jcon) + + use clust_data + + use io_units, only: iout + use io_base, only: permut + use geometry_data, only: nres,c,cref,tabperm + use energy_data, only: nct,nnt + use control_data, only: symetr,lside,nend,nstart + use regularize_, only: fitsq + implicit none +! include 'DIMENSIONS' +! include 'sizesclu.dat' +! include 'COMMON.CONTROL' +! include 'COMMON.CLUSTER' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.IOUNITS' + logical :: non_conv + real(kind=8) :: przes(3),obrot(3,3) + real(kind=8) :: xx(3,2*nres),yy(3,2*nres) !(3,maxres2) + integer :: i,ii,j,icon,jcon,kkk,nperm,chalen,zzz + integer :: iaperm,ibezperm,run + real(kind=8) :: rms,rmsmina +! write (iout,*) "tu dochodze" + rmsmina=10d10 + nperm=1 + do i=1,symetr + nperm=i*nperm + enddo +! write (iout,*) "nperm",nperm + call permut(symetr) +! write (iout,*) "tabperm", tabperm(1,1) + do kkk=1,nperm + if (lside) then + ii=0 + chalen=int((nend-nstart+2)/symetr) + do run=1,symetr + do i=nstart,(nstart+chalen-1) + zzz=tabperm(kkk,run) +! write (iout,*) "tutaj",zzz + ii=ii+1 + iaperm=(zzz-1)*chalen+i + ibezperm=(run-1)*chalen+i + do j=1,3 + xx(j,ii)=allcart(j,iaperm,jcon) + yy(j,ii)=cref(j,ibezperm,kkk) + enddo + enddo + enddo + do run=1,symetr + do i=nstart,(nstart+chalen-1) + zzz=tabperm(kkk,run) + ii=ii+1 + iaperm=(zzz-1)*chalen+i + ibezperm=(run-1)*chalen+i +! 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,kkk) + enddo + enddo +! endif + enddo + call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv) + else + chalen=int((nct-nnt+2)/symetr) + do run=1,symetr + do i=nnt,(nnt+chalen-1) + zzz=tabperm(kkk,run) +! write (iout,*) "tu szukaj", zzz,run,kkk + iaperm=(zzz-1)*chalen+i + ibezperm=(run-1)*chalen+i +! do i=nnt,nct + do j=1,3 + c(j,i)=allcart(j,iaperm,jcon) + enddo + enddo + enddo + call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1,& + przes,& + obrot,non_conv) + endif + if (rms.lt.0.0) then + print *,'error, rms^2 = ',rms,icon,jcon + stop + endif + if (non_conv) print *,non_conv,icon,jcon + if (rmsmina.gt.rms) rmsmina=rms + enddo + difconf=dsqrt(rmsmina) + return + end function difconf +!------------------------------------------------------------------------------ + subroutine distout(ncon) + + use clust_data + use hc_, only:ioffset + use io_units, only: iout + implicit none +! include 'DIMENSIONS' +! include 'sizesclu.dat' + integer :: ncon + integer,parameter :: ncol=10 +! include 'COMMON.IOUNITS' +! include 'COMMON.CLUSTER' + integer :: i,j,k,jlim,jlim1,nlim,ind + real(kind=4) :: b(ncol) + + write (iout,'(a)') 'The distance matrix' + do 1 i=1,ncon,ncol + nlim=min0(i+ncol-1,ncon) + write (iout,1000) (k,k=i,nlim) + write (iout,'(8h--------,10a)') ('-------',k=i,nlim) + 1000 format (/8x,10(i4,3x)) + 1020 format (/1x,80(1h-)/) + do 2 j=i,ncon + jlim=min0(j,nlim) + if (jlim.eq.j) then + b(jlim-i+1)=0.0d0 + jlim1=jlim-1 + else + jlim1=jlim + endif + do 3 k=i,jlim1 + if (j.lt.k) then + IND=IOFFSET(NCON,j,k) + else + IND=IOFFSET(NCON,k,j) + endif + 3 b(k-i+1)=diss(IND) + write (iout,1010) j,(b(k),k=1,jlim-i+1) + 2 continue + 1 continue + 1010 format (i5,3x,10(f6.2,1x)) + return + end subroutine distout +!------------------------------------------------------------------------------ +! srtclust.f +!------------------------------------------------------------------------------ + SUBROUTINE SRTCLUST(ICUT,NCON,IB) + + use clust_data + use io_units, only: iout +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'sizesclu.dat' +! include 'COMMON.CLUSTER' +! include 'COMMON.FREE' +! include 'COMMON.IOUNITS' + implicit none + real(kind=8),dimension(:),allocatable :: prob !(maxgr) + real(kind=8) :: emin,ene,en1,sumprob + integer :: igr,i,ii,li1,li2,ligr,ico,jco,ind1,ind2 + integer :: jgr,li,nco,ib,ncon,icut +! +! Compute free energies of clusters +! + allocate(prob(maxgr)) + + do igr=1,ngr + emin=totfree(nconf(igr,1)) + totfree_gr(igr)=1.0d0 + do i=2,licz(igr) + ii=nconf(igr,i) + totfree_gr(igr)=totfree_gr(igr)+dexp(-totfree(ii)+emin) + enddo +! write (iout,*) "igr",igr," totfree",emin, +! & " totfree_gr",totfree_gr(igr) + totfree_gr(igr)=emin-dlog(totfree_gr(igr)) +! write (iout,*) igr," efree",totfree_gr(igr)/beta_h(ib) + enddo +! +! SORT CONFORMATIONS IN GROUPS ACC. TO ENERGY +! + DO 16 IGR=1,NGR + LIGR=LICZ(IGR) + DO 17 ICO=1,LIGR-1 + IND1=NCONF(IGR,ICO) + ENE=totfree(IND1) + DO 18 JCO=ICO+1,LIGR + IND2=NCONF(IGR,JCO) + EN1=totfree(IND2) + IF (EN1.LT.ENE) THEN + NCONF(IGR,ICO)=IND2 + NCONF(IGR,JCO)=IND1 + IND1=IND2 + ENE=EN1 + ENDIF + 18 CONTINUE + 17 CONTINUE + 16 CONTINUE +! +! SORT GROUPS +! + DO 71 IGR=1,NGR + ENE=totfree_gr(IGR) + DO 72 JGR=IGR+1,NGR + EN1=totfree_gr(JGR) + IF (EN1.LT.ENE) THEN + LI1=LICZ(IGR) + LI2=LICZ(JGR) + LI=MAX0(LI1,LI2) + DO 73 I=1,LI + NCO=NCONF(IGR,I) + NCONF(IGR,I)=NCONF(JGR,I) + NCONF(JGR,I)=NCO + 73 CONTINUE + totfree_gr(igr)=en1 + totfree_gr(jgr)=ene + ENE=EN1 + LICZ(IGR)=LI2 + LICZ(JGR)=LI1 + ENDIF + 72 CONTINUE + 71 CONTINUE + write (iout,'("Free energies and probabilities of clusters at",f6.1," K")')& + 1.0d0/(1.987d-3*beta_h(ib)) !' + prob(1)=1.0d0 + sumprob=1.0d0 + do i=2,ngr + prob(i)=dexp(-(totfree_gr(i)-totfree_gr(1))) + sumprob=sumprob+prob(i) + enddo + do i=1,ngr + prob(i)=prob(i)/sumprob + enddo + sumprob=0.0d0 + write (iout,'("clust efree 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 + 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) +! write (iout,*) icut,i,iass(i),iass_tot(i,icut) + enddo + endif + RETURN + END SUBROUTINE SRTCLUST +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ diff --git a/source/cluster/hc.f90 b/source/cluster/hc.f90 new file mode 100644 index 0000000..113e71c --- /dev/null +++ b/source/cluster/hc.f90 @@ -0,0 +1,511 @@ +!*********************** Contents **************************************** +!* Sample driver program, VAX-11 Fortran; ********************************** +!* HC: O(n^2) time, O(n^2) space hierarchical clustering, Fortran 77 ******* +!* HCASS: determine cluster-memberships, Fortran 77. *********************** +!* HCDEN: draw upper part of dendrogram, VAX-11 Fortran. ******************* +!* Sample data set: last 36 lines. ***************************************** +!*************************************************************************** +! REAL DATA(18,16),CRIT(18),MEMBR(18) +! REAL CRITVAL(9) +! INTEGER IA(18),IB(18) +! INTEGER ICLASS(18,9),HVALS(9) +! INTEGER IORDER(9),HEIGHT(9) +! DIMENSION NN(18),DISNN(18) +! REAL D(153) +! LOGICAL FLAG(18) +! IN ABOVE, 18=N, 16=M, 9=LEV, 153=N(N-1)/2. +! +! +! OPEN(UNIT=21,STATUS='OLD',FILE='SPECTR.DAT') +! +! +! N = 18 +! M = 16 +! DO I=1,N +! READ(21,100)(DATA(I,J),J=1,M) +! ENDDO +! 100 FORMAT(8F7.1) +! +! +! LEN = (N*(N-1))/2 +! IOPT=1 +! CALL HC(N,M,LEN,IOPT,DATA,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,D) +! +! +! LEV = 9 +! CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) +! +! +! CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL) +! +! +! END +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C +! C +! HIERARCHICAL CLUSTERING using (user-specified) criterion. C +! C +! Parameters: C +! C +!removed DATA(N,M) input data matrix, C +! DISS(LEN) dissimilarities in lower half diagonal C +! storage; LEN = N.N-1/2, C +! IOPT clustering criterion to be used, C +! IA, IB, CRIT history of agglomerations; dimensions C +! N, first N-1 locations only used, C +! MEMBR, NN, DISNN vectors of length N, used to store C +! cluster cardinalities, current nearest C +! neighbour, and the dissimilarity assoc. C +! with the latter. C +! FLAG boolean indicator of agglomerable obj./ C +! clusters. C +! C +! F. Murtagh, ESA/ESO/STECF, Garching, February 1986. C +! C +!------------------------------------------------------------C + module hc_ +!----------------------------------------------------------------------------- + use io_units + use names + use clust_data + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- +! hc.f +!----------------------------------------------------------------------------- + + SUBROUTINE HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,& + FLAG,DISS) + integer :: N,M,LEN,IOPT + REAL(kind=4) :: MEMBR(N) + REAL(kind=4) :: DISS(LEN) + INTEGER :: IA(N),IB(N) + REAL(kind=4) :: CRIT(N) + integer,DIMENSION(N) :: NN + real(kind=4),dimension(N) ::DISNN + LOGICAL :: FLAG(N) + REAL(kind=4) INF + DATA INF /1.E+20/ + integer :: I,J,NCL,IND,IM,JM,I2,J2,K,IND1,IND2,IND3,JJ + real(kind=8) :: DMIN,X,XX +! +! Initializations +! + DO I=1,N + MEMBR(I)=1. + FLAG(I)=.TRUE. + ENDDO + NCL=N +! +! Construct dissimilarity matrix +! + DO I=1,N-1 + DO J=I+1,N + IND=IOFFSET(N,I,J) +!input DISS(IND)=0. +!input DO K=1,M +!input DISS(IND)=DISS(IND)+(DATA(I,K)-DATA(J,K))**2 +!input ENDDO + IF (IOPT.EQ.1) DISS(IND)=DISS(IND)/2. +! (Above is done for the case of the min. var. method +! where merging criteria are defined in terms of variances +! rather than distances.) + ENDDO + ENDDO +! +! Carry out an agglomeration - first create list of NNs +! + DO I=1,N-1 + DMIN=INF + DO J=I+1,N + IND=IOFFSET(N,I,J) + IF (DISS(IND).GE.DMIN) GOTO 500 + DMIN=DISS(IND) + JM=J + 500 CONTINUE + ENDDO + NN(I)=JM + DISNN(I)=DMIN + ENDDO +! + 400 CONTINUE +! Next, determine least diss. using list of NNs + DMIN=INF + DO I=1,N-1 + IF (.NOT.FLAG(I)) GOTO 600 + IF (DISNN(I).GE.DMIN) GOTO 600 + DMIN=DISNN(I) + IM=I + JM=NN(I) + 600 CONTINUE + ENDDO + NCL=NCL-1 +! +! This allows an agglomeration to be carried out. +! + I2=MIN0(IM,JM) + J2=MAX0(IM,JM) + IA(N-NCL)=I2 + IB(N-NCL)=J2 + CRIT(N-NCL)=DMIN +! +! Update dissimilarities from new cluster. +! + FLAG(J2)=.FALSE. + DMIN=INF + DO K=1,N + IF (.NOT.FLAG(K)) GOTO 800 + IF (K.EQ.I2) GOTO 800 + X=MEMBR(I2)+MEMBR(J2)+MEMBR(K) + IF (I2.LT.K) THEN + IND1=IOFFSET(N,I2,K) + ELSE + IND1=IOFFSET(N,K,I2) + ENDIF + IF (J2.LT.K) THEN + IND2=IOFFSET(N,J2,K) + ELSE + IND2=IOFFSET(N,K,J2) + ENDIF + IND3=IOFFSET(N,I2,J2) + XX=DISS(IND3) +! +! WARD'S MINIMUM VARIANCE METHOD - IOPT=1. +! + IF (IOPT.EQ.1) THEN + DISS(IND1)=(MEMBR(I2)+MEMBR(K))*DISS(IND1)+ & + (MEMBR(J2)+MEMBR(K))*DISS(IND2)- & + MEMBR(K)*XX + DISS(IND1)=DISS(IND1)/X + ENDIF +! +! SINGLE LINK METHOD - IOPT=2. +! + IF (IOPT.EQ.2) THEN + DISS(IND1)=MIN(DISS(IND1),DISS(IND2)) + ENDIF +! +! COMPLETE LINK METHOD - IOPT=3. +! + IF (IOPT.EQ.3) THEN + DISS(IND1)=MAX(DISS(IND1),DISS(IND2)) + ENDIF +! +! AVERAGE LINK (OR GROUP AVERAGE) METHOD - IOPT=4. +! + IF (IOPT.EQ.4) THEN + DISS(IND1)=(MEMBR(I2)*DISS(IND1)+MEMBR(J2)*DISS(IND2))/ & + (MEMBR(I2)+MEMBR(J2)) + ENDIF +! +! MCQUITTY'S METHOD - IOPT=5. +! + IF (IOPT.EQ.5) THEN + DISS(IND1)=0.5*DISS(IND1)+0.5*DISS(IND2) + ENDIF +! +! MEDIAN (GOWER'S) METHOD - IOPT=6. +! + IF (IOPT.EQ.6) THEN + DISS(IND1)=0.5*DISS(IND1)+0.5*DISS(IND2)-0.25*XX + ENDIF +! +! CENTROID METHOD - IOPT=7. +! + IF (IOPT.EQ.7) THEN + DISS(IND1)=(MEMBR(I2)*DISS(IND1)+MEMBR(J2)*DISS(IND2)- & + MEMBR(I2)*MEMBR(J2)*XX/(MEMBR(I2)+MEMBR(J2)))/ & + (MEMBR(I2)+MEMBR(J2)) + ENDIF +! + IF (I2.GT.K) GOTO 800 + IF (DISS(IND1).GE.DMIN) GOTO 800 + DMIN=DISS(IND1) + JJ=K + 800 CONTINUE + ENDDO + MEMBR(I2)=MEMBR(I2)+MEMBR(J2) + DISNN(I2)=DMIN + NN(I2)=JJ +! +! Update list of NNs insofar as this is required. +! + DO I=1,N-1 + IF (.NOT.FLAG(I)) GOTO 900 + IF (NN(I).EQ.I2) GOTO 850 + IF (NN(I).EQ.J2) GOTO 850 + GOTO 900 + 850 CONTINUE +! (Redetermine NN of I:) + DMIN=INF + DO J=I+1,N + IND=IOFFSET(N,I,J) + IF (.NOT.FLAG(J)) GOTO 870 + IF (I.EQ.J) GOTO 870 + IF (DISS(IND).GE.DMIN) GOTO 870 + DMIN=DISS(IND) + JJ=J + 870 CONTINUE + ENDDO + NN(I)=JJ + DISNN(I)=DMIN + 900 CONTINUE + ENDDO +! +! Repeat previous steps until N-1 agglomerations carried out. +! + IF (NCL.GT.1) GOTO 400 +! +! + RETURN + END SUBROUTINE HC +!----------------------------------------------------------------------------- +! +! + integer FUNCTION IOFFSET(N,I,J) +! Map row I and column J of upper half diagonal symmetric matrix +! onto vector. + integer :: N,I,J + IOFFSET=J+(I-1)*N-(I*(I+1))/2 + RETURN + END FUNCTION IOFFSET +!----------------------------------------------------------------------------- +!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C +! C +! Given a HIERARCHIC CLUSTERING, described as a sequence of C +! agglomerations, derive the assignments into clusters for the C +! top LEV-1 levels of the hierarchy. C +! Prepare also the required data for representing the C +! dendrogram of this top part of the hierarchy. C +! C +! Parameters: C +! C +! IA, IB, CRIT: vectors of dimension N defining the agglomer- C +! ations. C +! LEV: number of clusters in largest partition. C +! HVALS: vector of dim. LEV, used internally only. C +! ICLASS: array of cluster assignments; dim. N by LEV. C +! IORDER, CRITVAL, HEIGHT: vectors describing the dendrogram, C +! all of dim. LEV. C +! C +! F. Murtagh, ESA/ESO/STECF, Garching, February 1986. C +! C +! HISTORY C +! C +! Bounds bug fix, Oct. 1990, F. Murtagh. C +! Inserted line "IF (LOC.GT.LEV) GOTO 58" on line 48. This was C +! occassioned by incorrect termination of this loop when I C +! reached its (lower) extremity, i.e. N-LEV. Without the C +! /CHECK=(BOUNDS) option on VAX/VMS compilation, this inserted C +! statement was not necessary. C +!---------------------------------------------------------------C + SUBROUTINE HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,& + CRITVAL,HEIGHT) +! include 'sizesclu.dat' +! include 'COMMON.IOUNITS' + integer :: N,LEV +!el integer :: ICLASS(maxconf,maxconf-1) + integer :: ICLASS(N,N-1) + INTEGER :: IA(N),IB(N),HVALS(LEV),IORDER(LEV),& + HEIGHT(LEV) + REAL(kind=4) :: CRIT(N),CRITVAL(LEV) + integer :: I,J,LOC,LEVEL,ICL,ILEV,NCL,K +! +! Pick out the clusters which the N objects belong to, +! at levels N-2, N-3, ... N-LEV+1 of the hierarchy. +! The clusters are identified by the lowest seq. no. of +! their members. +! There are 2, 3, ... LEV clusters, respectively, for the +! above levels of the hierarchy. +! + HVALS(1)=1 + HVALS(2)=IB(N-1) + LOC=3 + DO 59 I=N-2,N-LEV,-1 + DO 52 J=1,LOC-1 + IF (IA(I).EQ.HVALS(J)) GOTO 54 + 52 CONTINUE + HVALS(LOC)=IA(I) + LOC=LOC+1 + 54 CONTINUE + DO 56 J=1,LOC-1 + IF (IB(I).EQ.HVALS(J)) GOTO 58 + 56 CONTINUE + IF (LOC.GT.LEV) GOTO 58 + HVALS(LOC)=IB(I) + LOC=LOC+1 + 58 CONTINUE + 59 CONTINUE +! + DO 400 LEVEL=N-LEV,N-2 + DO 200 I=1,N + ICL=I + DO 100 ILEV=1,LEVEL + 100 IF (IB(ILEV).EQ.ICL) ICL=IA(ILEV) + NCL=N-LEVEL + ICLASS(I,NCL-1)=ICL + 200 CONTINUE + 400 CONTINUE +! + DO 120 I=1,N + DO 120 J=1,LEV-1 + DO 110 K=2,LEV + IF (ICLASS(I,J).NE.HVALS(K)) GOTO 110 + ICLASS(I,J)=K + GOTO 120 + 110 CONTINUE + 120 CONTINUE +! + WRITE (iout,450) (j,j=2,LEV) + 450 FORMAT(4X,' SEQ NOS',8(i2,'CL'),10000(i3,'CL')) + 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) + 600 FORMAT(I11,8I4,10000i5) + 500 CONTINUE +! +! Determine an ordering of the LEV clusters (at level LEV-1) +! for later representation of the dendrogram. +! These are stored in IORDER. +! Determine the associated ordering of the criterion values +! for the vertical lines in the dendrogram. +! The ordinal values of these criterion values may be used in +! preference, and these are stored in HEIGHT. +! Finally, note that the LEV clusters are renamed so that they +! have seq. nos. 1 to LEV. +! + IORDER(1)=IA(N-1) + IORDER(2)=IB(N-1) + CRITVAL(1)=0.0 + CRITVAL(2)=CRIT(N-1) + HEIGHT(1)=LEV + HEIGHT(2)=LEV-1 + LOC=2 + DO 700 I=N-2,N-LEV+1,-1 + DO 650 J=1,LOC + IF (IA(I).EQ.IORDER(J)) THEN +! Shift rightwards and insert IB(I) beside IORDER(J): + DO 630 K=LOC+1,J+1,-1 + IORDER(K)=IORDER(K-1) + CRITVAL(K)=CRITVAL(K-1) + HEIGHT(K)=HEIGHT(K-1) + 630 CONTINUE + IORDER(J+1)=IB(I) + CRITVAL(J+1)=CRIT(I) + HEIGHT(J+1)=I-(N-LEV) + LOC=LOC+1 + ENDIF + 650 CONTINUE + 700 CONTINUE + DO 705 I=1,LEV + DO 703 J=1,LEV + IF (HVALS(I).EQ.IORDER(J)) THEN + IORDER(J)=I + GOTO 705 + ENDIF + 703 CONTINUE + 705 CONTINUE +! + RETURN + END SUBROUTINE HCASS +!----------------------------------------------------------------------------- +!+++++++++++++++++++++++++++++++++++++++++++++++++C +! C +! Construct a DENDROGRAM of the top 8 levels of C +! a HIERARCHIC CLUSTERING. C +! C +! Parameters: C +! C +! IORDER, HEIGHT, CRITVAL: vectors of length LEV C +! defining the dendrogram. C +! These are: the ordering of objects C +! along the bottom of the dendrogram C +! (IORDER); the height of the vertical C +! above each object, in ordinal values C +! (HEIGHT); and in real values (CRITVAL).C +! C +! NOTE: these vectors MUST have been set up with C +! LEV = 9 in the prior call to routine C +! HCASS. +! C +! F. Murtagh, ESA/ESO/STECF, Garching, Feb. 1986.C +! C +!-------------------------------------------------C + SUBROUTINE HCDEN(LEV,IORDER,HEIGHT,CRITVAL) +! include 'COMMON.IOUNITS' + integer :: LEV + CHARACTER(len=80) :: LINE + INTEGER :: IORDER(LEV),HEIGHT(LEV) + REAL(kind=4) :: CRITVAL(LEV) +! INTEGER OUT(3*LEV,3*LEV) +! INTEGER UP,ACROSS,BLANK + CHARACTER(len=1) :: OUT(3*LEV,3*LEV) + CHARACTER(len=1) :: UP,ACROSS,BLANK + DATA UP,ACROSS,BLANK /'|','-',' '/ + integer :: I,I2,J,J2,K,I3,L,IC,IDUM +! +! + DO I=1,3*LEV + DO J=1,3*LEV + OUT(I,J)=BLANK + ENDDO + ENDDO +! +! + DO I=3,3*LEV,3 + I2=I/3 +! + J2=3*LEV+1-3*HEIGHT(I2) + DO J=3*LEV,J2,-1 + OUT(J,I)=UP + ENDDO +! + DO K=I,3,-1 + I3=INT((K+2)/3) + IF ( (3*LEV+1-HEIGHT(I3)*3).LT.J2) GOTO 100 + OUT(J2,K)=ACROSS + ENDDO + 100 CONTINUE +! + ENDDO +! +! + IC=3 + DO I=1,3*LEV + IF (I.EQ.IC+1) THEN + IDUM=IC/3 + IDUM=LEV-IDUM + DO L=1,LEV + IF (HEIGHT(L).EQ.IDUM) GOTO 190 + ENDDO + 190 IDUM=L + 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) + 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) + 220 FORMAT(1H ,24X,9000I3) + WRITE(iout,230) LEV + 230 FORMAT(1H ,13X,'CRITERION CLUSTERS 1 TO ',i3) + WRITE(iout,240) LEV-1 + 240 FORMAT(1H ,13X,'VALUES. (TOP ',i3,' LEVELS OF HIERARCHY).') + 250 FORMAT(/) +! +! + RETURN + END SUBROUTINE HCDEN +!----------------------------------------------------------------------------- + end module hc_ +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- diff --git a/source/cluster/io_clust.f90 b/source/cluster/io_clust.f90 new file mode 100644 index 0000000..db74bf6 --- /dev/null +++ b/source/cluster/io_clust.f90 @@ -0,0 +1,1824 @@ + module io_clust +!----------------------------------------------------------------------------- + use clust_data + use io_units +! use names + use io_base !, only: ilen + use geometry_data, only: nres,c + use energy_data, only: nnt,nct,nss + use control_data, only: lside + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- +! wrtclust.f +!----------------------------------------------------------------------------- + SUBROUTINE WRTCLUST(NCON,ICUT,PRINTANG,PRINTPDB,printmol2,ib) + + use hc_, only: ioffset + use control_data, only: lprint_cart,lprint_int,titel + use geometry, only: int_from_cart1,nres +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'sizesclu.dat' + integer,parameter :: num_in_line=5 + LOGICAL :: PRINTANG(max_cut) + integer :: PRINTPDB(max_cut),printmol2(max_cut) +! include 'COMMON.CONTROL' +! include 'COMMON.HEADER' +! include 'COMMON.CHAIN' +! include 'COMMON.VAR' +! include 'COMMON.CLUSTER' +! include 'COMMON.IOUNITS' +! include 'COMMON.GEO' +! include 'COMMON.FREE' +! include 'COMMON.TEMPFAC' + real(kind=8) :: rmsave(maxgr) + CHARACTER(len=64) :: prefixp,NUMM,MUMM,EXTEN,extmol + character(len=80) :: cfname + character(len=8) :: ctemper + DATA EXTEN /'.pdb'/,extmol /'.mol2'/,NUMM /'000'/,& + MUMM /'000'/ +! external ilen + integer :: ncon,icut,ib + integer :: i,ii,ii1,ii2,igr,ind1,ind2,ico,icon,& + irecord,nrecord,j,k,jj,ind,ncon_lim,ncon_out + real(kind=8) :: temper,curr_dist,emin,qpart,boltz,& + ave_dim,amax_dim,emin1 + + + allocate(tempfac(2,nres)) + + do i=1,64 + cfname(i:i)=" " + enddo +! print *,"calling WRTCLUST",ncon +! write (iout,*) "ICUT",icut," PRINTPDB ",PRINTPDB(icut) + rewind 80 + call flush(iout) + temper=1.0d0/(beta_h(ib)*1.987d-3) + if (temper.lt.100.0d0) then + write(ctemper,'(f3.0)') temper + ctemper(3:3)=" " + else if (temper.lt.1000.0) then + write (ctemper,'(f4.0)') temper + ctemper(4:4)=" " + else + write (ctemper,'(f5.0)') temper + ctemper(5:5)=" " + endif + + do i=1,ncon*(ncon-1)/2 + read (80) diss(i) + enddo + close(80,status='delete') +! +! PRINT OUT THE RESULTS OF CLUSTER ANALYSIS +! + ii1= index(intinname,'/') + ii2=ii1 + ii1=ii1+1 + do while (ii2.gt.0) + ii1=ii1+ii2 + ii2=index(intinname(ii1:),'/') + enddo + ii = ii1+index(intinname(ii1:),'.')-1 + if (ii.eq.0) then + ii=ilen(intinname) + else + ii=ii-1 + endif + prefixp=intinname(ii1:ii) +!d print *,icut,printang(icut),printpdb(icut),printmol2(icut) +!d print *,'ecut=',ecut + WRITE (iout,100) NGR + DO 19 IGR=1,NGR + WRITE (iout,200) IGR,totfree_gr(igr)/beta_h(ib),LICZ(IGR) + NRECORD=LICZ(IGR)/num_in_line + IND1=1 + DO 63 IRECORD=1,NRECORD + IND2=IND1+num_in_line-1 + WRITE (iout,300) (list_conf(NCONF(IGR,ICO)),& + totfree(NCONF(IGR,ICO))/beta_h(ib),ICO=IND1,IND2) + IND1=IND2+1 + 63 CONTINUE + WRITE (iout,300) (list_conf(NCONF(IGR,ICO)),& + totfree(NCONF(IGR,ICO))/beta_h(ib),ICO=IND1,LICZ(IGR)) + IND1=1 + ICON=list_conf(NCONF(IGR,1)) +! WRITE (iout,'(16F5.0)') (rad2deg*phiall(IND,icon),IND=4,nphi+3) +! 12/8/93 Estimation of "diameters" of the subsequent families. + ave_dim=0.0 + amax_dim=0.0 +! write (iout,*) "ecut",ecut + do i=2,licz(igr) + ii=nconf(igr,i) + if (totfree(ii)-emin .gt. ecut) goto 10 + do j=1,i-1 + jj=nconf(igr,j) + if (jj.eq.1) exit + if (ii.lt.jj) then + ind=ioffset(ncon,ii,jj) + else + ind=ioffset(ncon,jj,ii) + endif +! write (iout,*) " ncon",ncon,"i",i," j",j," ii",ii," jj",jj, +! & " ind",ind + call flush(iout) + curr_dist=dabs(diss(ind)+0.0d0) +! write(iout,'(i10,4i4,f12.4)') ind,ii,jj,list_conf(ii), +! & list_conf(jj),curr_dist + if (curr_dist .gt. amax_dim) amax_dim=curr_dist + ave_dim=ave_dim+curr_dist**2 + enddo + enddo + 10 if (licz(igr) .gt. 1) & + ave_dim=sqrt(ave_dim/(licz(igr)*(licz(igr)-1)/2)) + write (iout,'(/A,F8.1,A,F8.1)') & + 'Max. distance in the family:',amax_dim,& + '; average distance in the family:',ave_dim + rmsave(igr)=0.0d0 + qpart=0.0d0 + do i=1,licz(igr) + icon=nconf(igr,i) + boltz=dexp(-totfree(icon)) + rmsave(igr)=rmsave(igr)+boltz*rmstb(icon) + qpart=qpart+boltz + enddo + rmsave(igr)=rmsave(igr)/qpart + write (iout,'(a,f5.2,a)') "Average RMSD",rmsave(igr)," A" + 19 CONTINUE + WRITE (iout,400) + WRITE (iout,500) (list_conf(I),IASS(I),I=1,NCON) +! print *,icut,printang(icut) + IF (PRINTANG(ICUT) .and. (lprint_cart .or. lprint_int)) then + emin=totfree_gr(1) +! print *,'emin',emin,' ngr',ngr + if (lprint_cart) then + cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper))& + //"K"//".x" + else + cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper))& + //"K"//".int" + endif + do igr=1,ngr + icon=nconf(igr,1) + if (totfree_gr(igr)-emin.le.ecut) then + if (lprint_cart) then + call cartout(igr,icon,totfree(icon)/beta_h(ib),& + totfree_gr(igr)/beta_h(ib),& + rmstb(icon),cfname) + else +! print '(a)','calling briefout' + do i=1,2*nres + do j=1,3 + c(j,i)=allcart(j,i,icon) + enddo + enddo + call int_from_cart1(.false.) +!el call briefout(igr,iscore(icon),totfree(icon)/beta_h(ib),& +!el totfree_gr(igr),nss_all(icon),ihpb_all(1,icon),& +!el jhpb_all(1,icon),cfname) + call briefout(igr,totfree(icon)/beta_h(ib),& + totfree_gr(igr)) +! print '(a)','exit briefout' + endif + endif + enddo + close(igeom) + ENDIF + IF (PRINTPDB(ICUT).gt.0) THEN +! Write out a number of conformations from each family in PDB format and +! create InsightII command file for their displaying in different colors + cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper))& + //"K_"//'ave'//exten + write (iout,*) "cfname",cfname + OPEN(ipdb,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') + write (ipdb,'(a,f8.2)') & + "REMAR AVERAGE CONFORMATIONS AT TEMPERATURE",temper + close (ipdb) + I=1 + ICON=NCONF(1,1) + EMIN=totfree_gr(I) + emin1=totfree(icon) + DO WHILE(I.LE.NGR .AND. totfree_gr(i)-EMIN.LE.ECUT) +! write (iout,*) "i",i," ngr",ngr,totfree_gr(I),EMIN,ecut + write (NUMM,'(bz,i4.4)') i + ncon_lim=min0(licz(i),printpdb(icut)) + cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper))& + //"K_"//numm(:ilen(numm))//exten + OPEN(ipdb,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') + write (ipdb,'("REMARK CLUSTER",i5," FREE ENERGY",1pe14.5," AVE RMSD",0pf5.2)')& + i,totfree_gr(i)/beta_h(ib),rmsave(i) !' +! Write conformations of the family i to PDB files + ncon_out=1 + do while (ncon_out.lt.printpdb(icut) .and. & + ncon_out.lt.licz(i).and. & + totfree(nconf(i,ncon_out+1))-EMIN1.LE.ECUT) + ncon_out=ncon_out+1 +! write (iout,*) i,ncon_out,nconf(i,ncon_out), +! & totfree(nconf(i,ncon_out)),emin1,ecut + enddo + write (iout,*) "ncon_out",ncon_out + call flush(iout) + do j=1,nres + tempfac(1,j)=5.0d0 + tempfac(2,j)=5.0d0 + enddo + do j=1,ncon_out + icon=nconf(i,j) + do ii=1,2*nres + do k=1,3 + c(k,ii)=allcart(k,ii,icon) + enddo + enddo + call pdboutC(totfree(icon)/beta_h(ib),rmstb(icon),titel) + write (ipdb,'("TER")') + enddo + close(ipdb) +! Average structures and structures closest to average + cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper))& + //"K_"//'ave'//exten + OPEN(ipdb,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED',& + position="APPEND") + call ave_coord(i) + write (ipdb,'(a,i5)') "REMARK CLUSTER",i + call pdboutC(totfree_gr(i)/beta_h(ib),rmsave(i),titel) + write (ipdb,'("TER")') + call closest_coord(i) + call pdboutC(totfree_gr(i)/beta_h(ib),rmsave(i),titel) + write (ipdb,'("TER")') + close (ipdb) + I=I+1 + ICON=NCONF(I,1) + emin1=totfree(icon) + ENDDO + ENDIF + IF (printmol2(icut).gt.0) THEN +! Write out a number of conformations from each family in PDB format and +! create InsightII command file for their displaying in different colors + I=1 + ICON=NCONF(1,1) + EMIN=ENERGY(ICON) + emin1=emin + DO WHILE(I.LE.NGR .AND. totfree_gr(i)-EMIN.LE.ECUT) + write (NUMM,'(bz,i4.4)') i + cfname=prefixp(:ilen(prefixp))//"_T"//ctemper(:ilen(ctemper))& + //"K_"//numm(:ilen(numm))//extmol + OPEN(imol2,FILE=CFNAME,STATUS='UNKNOWN',FORM='FORMATTED') + ncon_out=1 + do while (ncon_out.lt.printmol2(icut) .and. & + ncon_out.lt.licz(i).and. & + totfree(nconf(i,ncon_out+1))-EMIN1.LE.ECUT) + ncon_out=ncon_out+1 + enddo + do j=1,ncon_out + icon=nconf(i,j) + do ii=1,2*nres + do k=1,3 + c(k,ii)=allcart(k,ii,icon) + enddo + enddo + CALL MOL2OUT(totfree(icon)/beta_h(ib),'STRUCTURE'//numm) + enddo + CLOSE(imol2) + I=I+1 + ICON=NCONF(I,1) + emin1=totfree(icon) + ENDDO + ENDIF + 100 FORMAT (//'THERE ARE ',I4,' FAMILIES OF CONFORMATIONS') + 200 FORMAT (/'FAMILY ',I4,' WITH TOTAL FREE ENERGY',1pE15.5,& + ' CONTAINS ',I4,' CONFORMATION(S): ') +! 300 FORMAT ( 8(I4,F6.1)) + 300 FORMAT (5(I4,1pe12.3)) + 400 FORMAT (//'ASSIGNMENT OF CONSECUTIVE CONFORMATIONS TO FAMILIES:') + 500 FORMAT (8(2I4,2X)) + 600 FORMAT ('REMARK FAMILY',I4,' CONFORMATION',I4,' ENERGY ',E15.6) + RETURN + END SUBROUTINE WRTCLUST +!------------------------------------------------------------------------------ + subroutine ave_coord(igr) + + use control_data, only:lside + use regularize_, only:fitsq,matvec +! implicit none +! include 'DIMENSIONS' +! include 'sizesclu.dat' +! include 'COMMON.CONTROL' +! include 'COMMON.CLUSTER' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.TEMPFAC' +! include 'COMMON.IOUNITS' + logical :: non_conv + real(kind=8) :: przes(3),obrot(3,3) + real(kind=8) :: xx(3,2*nres),yy(3,2*nres),csq(3,2*nres) !(3,maxres2) + real(kind=8) :: eref + integer :: i,ii,j,k,icon,jcon,igr + real(kind=8) :: rms,boltz,qpart,cwork(3,2*nres),cref1(3,2*nres) !(3,maxres2) +! write (iout,*) "AVE_COORD: igr",igr + jcon=nconf(igr,1) + eref=totfree(jcon) + boltz = dexp(-totfree(jcon)+eref) + qpart=boltz + do i=1,2*nres + do j=1,3 + c(j,i)=allcart(j,i,jcon)*boltz + cref1(j,i)=allcart(j,i,jcon) + csq(j,i)=allcart(j,i,jcon)**2*boltz + enddo + enddo + DO K=2,LICZ(IGR) + jcon=nconf(igr,k) + if (lside) then + ii=0 + do i=nnt,nct + ii=ii+1 + do j=1,3 + xx(j,ii)=allcart(j,i,jcon) + yy(j,ii)=cref1(j,i) + enddo + enddo + do i=nnt,nct +! if (itype(i).ne.10) then + ii=ii+1 + do j=1,3 + xx(j,ii)=allcart(j,i+nres,jcon) + yy(j,ii)=cref1(j,i+nres) + enddo +! endif + enddo + call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv) + else + do i=nnt,nct + do j=1,3 + cwork(j,i)=allcart(j,i,jcon) + enddo + enddo + call fitsq(rms,cwork(1,nnt),cref1(1,nnt),nct-nnt+1,przes,obrot & + ,non_conv) + endif +! write (iout,*) "rms",rms +! do i=1,3 +! write (iout,'(i3,f10.5,5x,3f10.5)')i,przes(i),(obrot(i,j),j=1,3) +! enddo + if (rms.lt.0.0) then + print *,'error, rms^2 = ',rms,icon,jcon + stop + endif + if (non_conv) print *,non_conv,icon,jcon + boltz=dexp(-totfree(jcon)+eref) + qpart = qpart + boltz + do i=1,2*nres + do j=1,3 + xx(j,i)=allcart(j,i,jcon) + enddo + enddo + call matvec(cwork,obrot,xx,2*nres) + do i=1,2*nres +! write (iout,'(i5,2(3f10.5,5x))') i,(cwork(j,i),j=1,3), +! & (allcart(j,i,jcon),j=1,3) + do j=1,3 + cwork(j,i)=cwork(j,i)+przes(j) + c(j,i)=c(j,i)+cwork(j,i)*boltz + csq(j,i)=csq(j,i)+cwork(j,i)**2*boltz + enddo + enddo + ENDDO ! K + do i=1,2*nres + do j=1,3 + c(j,i)=c(j,i)/qpart + csq(j,i)=csq(j,i)/qpart-c(j,i)**2 + enddo +! write (iout,'(i5,3f10.5)') i,(csq(j,i),j=1,3) + enddo + do i=nnt,nct + tempfac(1,i)=0.0d0 + tempfac(2,i)=0.0d0 + do j=1,3 + tempfac(1,i)=tempfac(1,i)+csq(j,i) + tempfac(2,i)=tempfac(2,i)+csq(j,i+nres) + enddo + tempfac(1,i)=dsqrt(tempfac(1,i)) + tempfac(2,i)=dsqrt(tempfac(2,i)) + enddo + return + end subroutine ave_coord +!------------------------------------------------------------------------------ + subroutine closest_coord(igr) + + use regularize_, only:fitsq +! 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' + logical :: non_conv + real(kind=8) :: przes(3),obrot(3,3) + real(kind=8) :: xx(3,2*nres),yy(3,2*nres) !(3,maxres2) + integer :: i,ii,j,k,icon,jcon,jconmin,igr + real(kind=8) :: rms,rmsmin,cwork(3,2*nres) + rmsmin=1.0d10 + jconmin=nconf(igr,1) + DO K=1,LICZ(IGR) + jcon=nconf(igr,k) + if (lside) then + ii=0 + do i=nnt,nct + ii=ii+1 + do j=1,3 + xx(j,ii)=allcart(j,i,jcon) + yy(j,ii)=c(j,i) + enddo + enddo + do i=nnt,nct +! if (itype(i).ne.10) then + ii=ii+1 + do j=1,3 + xx(j,ii)=allcart(j,i+nres,jcon) + yy(j,ii)=c(j,i+nres) + enddo +! endif + enddo + call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv) + else + do i=nnt,nct + do j=1,3 + cwork(j,i)=allcart(j,i,jcon) + enddo + enddo + call fitsq(rms,cwork(1,nnt),c(1,nnt),nct-nnt+1,przes,obrot,& + non_conv) + endif + if (rms.lt.0.0) then + print *,'error, rms^2 = ',rms,icon,jcon + stop + endif +! write (iout,*) "jcon",jcon," rms",rms," rmsmin",rmsmin + if (non_conv) print *,non_conv,icon,jcon + if (rms.lt.rmsmin) then + rmsmin=rms + jconmin=jcon + endif + ENDDO ! K +! write (iout,*) "rmsmin",rmsmin," rms",rms + call flush(iout) + do i=1,2*nres + do j=1,3 + c(j,i)=allcart(j,i,jconmin) + enddo + enddo + return + end subroutine closest_coord +!----------------------------------------------------------------------------- +! read_coords.F +!----------------------------------------------------------------------------- + subroutine read_coords(ncon,*) + + use energy_data, only: ihpb,jhpb,max_ene + use control_data, only: from_bx,from_cx + use control, only: tcpu +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" +#ifdef MPI + use MPI_data + include "mpif.h" + integer :: IERROR,ERRCODE !,STATUS(MPI_STATUS_SIZE) +! include "COMMON.MPI" +#else + use MPI_data, only: nprocs +#endif +! include "COMMON.CONTROL" +! include "COMMON.CHAIN" +! include "COMMON.INTERACT" +! include "COMMON.IOUNITS" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.CLUSTER" + character(len=3) :: liczba + integer :: ncon + integer :: i,j,jj,jjj,jj_old,icount,k,kk,l,ii,if,ib,& + nn,nn1,inan + integer :: ixdrf,iret,itmp + real(kind=4) :: prec,reini,refree,rmsdev + integer :: nrec,nlines,iscor,lenrec,lenrec_in + real(kind=8) :: energ,t_acq !,tcpu +!el integer ilen,iroof +!el external ilen,iroof + real(kind=8) :: rjunk + integer :: ntot_all(0:nprocs-1) !(0:maxprocs-1) + logical :: lerr + real(kind=8) :: energia(0:max_ene),etot + real(kind=4) :: csingle(3,2*nres+2) + integer :: Previous,Next + character(len=256) :: bprotfiles +! print *,"Processor",me," calls read_protein_data" +#ifdef MPI + if (me.eq.master) then + Previous=MPI_PROC_NULL + else + Previous=me-1 + endif + if (me.eq.nprocs-1) then + Next=MPI_PROC_NULL + else + Next=me+1 + endif +! Set the scratchfile names + write (liczba,'(bz,i3.3)') me + + allocate(STATUS(MPI_STATUS_SIZE)) +#endif +! 1/27/05 AL Change stored coordinates to single precision and don't store +! energy components in the binary databases. + lenrec=12*(nres+nct-nnt+1)+4*(2*nss+2)+16 + lenrec_in=12*(nres+nct-nnt+1)+4*(2*nss+2)+24 +#ifdef DEBUG + write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss", nss + write (iout,*) "lenrec_in",lenrec_in +#endif + bprotfiles=scratchdir(:ilen(scratchdir))// & + "/"//prefix(:ilen(prefix))//liczba//".xbin" +! EL +! allocate cluster arrays + allocate(energy(0:maxconf),totfree(0:maxconf)) !(0:maxconf) + allocate(entfac(maxconf)) !(maxconf) + allocate(rmstb(maxconf)) !(maxconf) + allocate(allcart(3,2*nres,maxstr_proc)) !(3,maxres2,maxstr_proc) + allocate(nss_all(maxstr_proc)) !(maxstr_proc) + allocate(ihpb_all(maxss,maxstr_proc),jhpb_all(maxss,maxstr_proc))!(maxss,maxstr_proc) + allocate(iscore(maxconf)) !(maxconf) + + +#ifdef CHUJ + ICON=1 + 123 continue + if (from_cart .and. .not. from_bx .and. .not. from_cx) then + if (efree) then + read (intin,*,end=13,err=11) energy(icon),totfree(icon),& + rmstb(icon),& + nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon),& + i=1,nss_all(icon)),iscore(icon) + else + read (intin,*,end=13,err=11) energy(icon),rmstb(icon),& + nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon),& + i=1,nss_all(icon)),iscore(icon) + endif + read (intin,'(8f10.5)',end=13,err=10) & + ((allcart(j,i,icon),j=1,3),i=1,nres),& + ((allcart(j,i+nres,icon),j=1,3),i=nnt,nct) + print *,icon,energy(icon),nss_all(icon),rmstb(icon) + else + read(intin,'(a80)',end=13,err=12) lineh + read(lineh(:5),*,err=8) ic + if (efree) then + read(lineh(6:),*,err=8) energy(icon) + else + read(lineh(6:),*,err=8) energy(icon) + endif + goto 9 + 8 ic=1 + print *,'error, assuming e=1d10',lineh + energy(icon)=1d10 + nss=0 + 9 continue +!old read(lineh(18:),*,end=13,err=11) nss_all(icon) + ii = index(lineh(15:)," ")+15 + read(lineh(ii:),*,end=13,err=11) nss_all(icon) + IF (NSS_all(icon).LT.9) THEN + read (lineh(20:),*,end=102) & + (IHPB_all(I,icon),JHPB_all(I,icon),I=1,NSS_all(icon)),& + iscore(icon) + ELSE + read (lineh(20:),*,end=102) & + (IHPB_all(I,icon),JHPB_all(I,icon),I=1,8) + read (intin,*) (IHPB_all(I,icon),JHPB_all(I,icon),& + I=9,NSS_all(icon)),iscore(icon) + ENDIF + + 102 continue + + PRINT *,'IC:',IC,' ENERGY:',ENERGY(ICON) + call read_angles(intin,*13) + do i=1,nres + phiall(i,icon)=phi(i) + thetall(i,icon)=theta(i) + alphall(i,icon)=alph(i) + omall(i,icon)=omeg(i) + enddo + endif + ICON=ICON+1 + GOTO 123 +! +! CALCULATE DISTANCES +! + 10 print *,'something wrong with angles' + goto 13 + 11 print *,'something wrong with NSS',nss + goto 13 + 12 print *,'something wrong with header' + + 13 NCON=ICON-1 + +#endif + call flush(iout) + jj_old=1 + open (icbase,file=bprotfiles,status="unknown",& + form="unformatted",access="direct",recl=lenrec) +! Read conformations from binary DA files (one per batch) and write them to +! a binary DA scratchfile. + jj=0 + jjj=0 +#ifdef MPI + write (liczba,'(bz,i3.3)') me + IF (ME.EQ.MASTER) THEN +! Only the master reads the database; it'll send it to the other procs +! through a ring. +#endif + t_acq = tcpu() + icount=0 + + if (from_bx) then + + open (intin,file=intinname,status="old",form="unformatted",& + access="direct",recl=lenrec_in) + + else if (from_cx) then +#if (defined(AIX) && !defined(JUBL)) + call xdrfopen_(ixdrf,intinname, "r", iret) +#else + call xdrfopen(ixdrf,intinname, "r", iret) +#endif + prec=10000.0 + write (iout,*) "xdrfopen: iret",iret + if (iret.eq.0) then + write (iout,*) "Error: coordinate file ",& + intinname(:ilen(intinname))," does not exist." + call flush(iout) +#ifdef MPI + call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE) +#endif + stop + endif + else + write (iout,*) "Error: coordinate format not specified" + call flush(iout) +#ifdef MPI + call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE) +#else + stop +#endif + endif + +!#define DEBUG +#ifdef DEBUG + write (iout,*) "Opening file ",intinname(:ilen(intinname)) + write (iout,*) "lenrec",lenrec_in + call flush(iout) +#endif +!#undef DEBUG +! write (iout,*) "maxconf",maxconf + i=0 + do while (.true.) + i=i+1 +!el if (i.gt.maxconf) then +!el write (iout,*) "Error: too many conformations ",& +!el "(",maxconf,") maximum." +!#ifdef MPI +!el call MPI_Abort(MPI_COMM_WORLD,errcode,ierror) +!#endif +!el stop +!el endif +! write (iout,*) "i",i +! call flush(iout) + if (from_bx) then + read(intin,err=101,end=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),& + energy(jj+1),& + entfac(jj+1),rmstb(jj+1),iscor + do j=1,2*nres + do k=1,3 + c(k,j)=csingle(k,j) + enddo + enddo + else +#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 + enddo + call xdrffloat_(ixdrf,reini,iret) + if (iret.eq.0) goto 101 + call xdrffloat_(ixdrf,refree,iret) + if (iret.eq.0) goto 101 + call xdrffloat_(ixdrf,rmsdev,iret) + if (iret.eq.0) goto 101 + call xdrfint_(ixdrf,iscor,iret) + if (iret.eq.0) goto 101 +#else +! write (iout,*) "calling xdrf3dfcoord" + call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret) +! write (iout,*) "iret",iret +! call flush(iout) + if (iret.eq.0) goto 101 + call xdrfint(ixdrf, nss, iret) +! write (iout,*) "iret",iret +! 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 + enddo + call xdrffloat(ixdrf,reini,iret) + if (iret.eq.0) goto 101 + call xdrffloat(ixdrf,refree,iret) + if (iret.eq.0) goto 101 + call xdrffloat(ixdrf,rmsdev,iret) + if (iret.eq.0) goto 101 + call xdrfint(ixdrf,iscor,iret) + if (iret.eq.0) goto 101 +#endif + energy(jj+1)=reini + entfac(jj+1)=refree + rmstb(jj+1)=rmsdev + do k=1,nres + do l=1,3 + c(l,k)=csingle(l,k) + enddo + enddo + do k=nnt,nct + do l=1,3 + c(l,nres+k)=csingle(l,nres+k-nnt+1) + enddo + enddo + endif +#ifdef DEBUG + write (iout,'(5hREAD ,i5,3f15.4,i10)') & + jj+1,energy(jj+1),entfac(jj+1),& + rmstb(jj+1),iscor + write (iout,*) "Conformation",jjj+1,jj+1 + 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) + call flush(iout) +#endif + call add_new_cconf(jjj,jj,jj_old,icount,Next) + enddo + 101 continue + write (iout,*) i-1," conformations read from DA file ",& + intinname(:ilen(intinname)) + write (iout,*) jj," conformations read so far" + if (from_bx) then + close(intin) + else +#if (defined(AIX) && !defined(JUBL)) + call xdrfclose_(ixdrf, iret) +#else + call xdrfclose(ixdrf, iret) +#endif + endif +#ifdef MPI +!#ifdef DEBUG + write (iout,*) "jj_old",jj_old," jj",jj +!#endif + call write_and_send_cconf(icount,jj_old,jj,Next) + call MPI_Send(0,1,MPI_INTEGER,Next,570,& + MPI_COMM_WORLD,IERROR) + jj_old=jj+1 +#else + call write_and_send_cconf(icount,jj_old,jj,Next) +#endif + t_acq = tcpu() - t_acq +#ifdef MPI + write (iout,*) "Processor",me,& + " time for conformation read/send",t_acq + ELSE +! A worker gets the confs from the master and sends them to its neighbor + t_acq = tcpu() + call receive_and_pass_cconf(icount,jj_old,jj,& + Previous,Next) + t_acq = tcpu() - t_acq + ENDIF +#endif + ncon=jj +! close(icbase) + close(intin) + + write(iout,*)"A total of",ncon," conformations read." + + allocate(enetb(1:max_ene,ncon)) !(max_ene,maxstr_proc) +#ifdef MPI +! Check if everyone has the same number of conformations + call MPI_Allgather(ncon,1,MPI_INTEGER,& + ntot_all(0),1,MPI_INTEGER,MPI_Comm_World,IERROR) + lerr=.false. + do i=0,nprocs-1 + if (i.ne.me) then + if (ncon.ne.ntot_all(i)) then + write (iout,*) "Number of conformations at processor",i,& + " differs from that at processor",me,& + ncon,ntot_all(i) + lerr = .true. + endif + endif + enddo + if (lerr) then + write (iout,*) + write (iout,*) "Number of conformations read by processors" + write (iout,*) + do i=0,nprocs-1 + write (iout,'(8i10)') i,ntot_all(i) + enddo + write (iout,*) "Calculation terminated." + call flush(iout) + return 1 + endif + return +#endif + 1111 write(iout,*) "Error opening coordinate file ",& + intinname(:ilen(intinname)) + call flush(iout) + return 1 + end subroutine read_coords +!------------------------------------------------------------------------------ + subroutine add_new_cconf(jjj,jj,jj_old,icount,Next) + + use geometry_data, only: vbld,rad2deg,theta,phi,alph,omeg,deg2rad + use energy_data, only: itel,itype,dsc,max_ene + use control_data, only: symetr + use geometry, only: int_from_cart1 +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" +! include "COMMON.CLUSTER" +! include "COMMON.CONTROL" +! include "COMMON.CHAIN" +! include "COMMON.INTERACT" +! include "COMMON.LOCAL" +! include "COMMON.IOUNITS" +! include "COMMON.NAMES" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" + integer :: i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib,& + nn,nn1,inan,Next,itj,chalen + real(kind=8) :: etot,energia(0:max_ene) + jjj=jjj+1 + 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 (j.gt.2) then + if (itel(j).ne.0 .and. itel(j-1).ne.0) then + write (iout,*) "Conformation",jjj,jj+1 + write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j),& + chalen + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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,*) & + "This conformation WILL NOT be added to the database." + return + endif + endif + endif + enddo + do j=nnt,nct + itj=itype(j) + if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))) & + .gt.2.0d0) then + write (iout,*) "Conformation",jjj,jj+1 + write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j) + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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,*) & + "This conformation WILL NOT be added to the database." + return + endif + enddo + do j=3,nres + if (theta(j).le.0.0d0) then + write (iout,*) & + "Zero theta angle(s) in conformation",jjj,jj+1 + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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,*) & + "This conformation WILL NOT be added to the database." + return + endif + if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad + enddo + jj=jj+1 +#ifdef DEBUG + write (iout,*) "Conformation",jjj,jj + 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.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)') (vbld(k+nres),k=nnt,nct) + 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) + write (iout,'(e15.5,16i5)') entfac(icount+1) +! & iscore(icount+1,0) +#endif + icount=icount+1 + call store_cconf_from_file(jj,icount) + if (icount.eq.maxstr_proc) then +#ifdef DEBUG + write (iout,* ) "jj_old",jj_old," jj",jj +#endif + call write_and_send_cconf(icount,jj_old,jj,Next) + jj_old=jj+1 + icount=0 + endif + return + end subroutine add_new_cconf +!------------------------------------------------------------------------------ + subroutine store_cconf_from_file(jj,icount) + + use energy_data, only: ihpb,jhpb +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" +! include "COMMON.CLUSTER" +! include "COMMON.CHAIN" +! include "COMMON.SBRIDGE" +! include "COMMON.INTERACT" +! include "COMMON.IOUNITS" +! include "COMMON.VAR" + integer :: i,j,jj,icount +! Store the conformation that has been read in + do i=1,2*nres + do j=1,3 + allcart(j,i,icount)=c(j,i) + enddo + enddo + nss_all(icount)=nss + do i=1,nss + ihpb_all(i,icount)=ihpb(i) + jhpb_all(i,icount)=jhpb(i) + enddo + return + end subroutine store_cconf_from_file +!------------------------------------------------------------------------------ + subroutine write_and_send_cconf(icount,jj_old,jj,Next) + +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" +#ifdef MPI + use MPI_data + include "mpif.h" + integer :: IERROR +! include "COMMON.MPI" +#endif +! include "COMMON.CHAIN" +! include "COMMON.SBRIDGE" +! include "COMMON.INTERACT" +! include "COMMON.IOUNITS" +! include "COMMON.CLUSTER" +! include "COMMON.VAR" + integer :: icount,jj_old,jj,Next +! Write the structures to a scratch file +#ifdef MPI +! Master sends the portion of conformations that have been read in to the neighbor +#ifdef DEBUG + write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF" + call flush(iout) +#endif + call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR) + call MPI_Send(nss_all(1),icount,MPI_INTEGER,& + Next,571,MPI_COMM_WORLD,IERROR) + call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,& + Next,572,MPI_COMM_WORLD,IERROR) + call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,& + Next,573,MPI_COMM_WORLD,IERROR) + call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,& + Next,577,MPI_COMM_WORLD,IERROR) + call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,& + Next,579,MPI_COMM_WORLD,IERROR) + call MPI_Send(allcart(1,1,1),3*icount*2*nres,& + MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR) +#endif + call dawrite_ccoords(jj_old,jj,icbase) + return + end subroutine write_and_send_cconf +!------------------------------------------------------------------------------ +#ifdef MPI + subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,Next) + + use MPI_data +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" + include "mpif.h" + integer :: IERROR !,STATUS(MPI_STATUS_SIZE) +! include "COMMON.MPI" +! include "COMMON.CHAIN" +! include "COMMON.SBRIDGE" +! include "COMMON.INTERACT" +! include "COMMON.IOUNITS" +! include "COMMON.VAR" +! include "COMMON.GEO" +! include "COMMON.CLUSTER" + integer :: i,j,k,icount,jj_old,jj,Previous,Next + icount=1 +#ifdef DEBUG + write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF" + call flush(iout) +#endif + do while (icount.gt.0) + call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,& + STATUS,IERROR) + call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,& + IERROR) +#ifdef DEBUG + write (iout,*) "Processor",me," icount",icount +#endif + if (icount.eq.0) return + call MPI_Recv(nss_all(1),icount,MPI_INTEGER,& + Previous,571,MPI_COMM_WORLD,STATUS,IERROR) + call MPI_Send(nss_all(1),icount,MPI_INTEGER,& + Next,571,MPI_COMM_WORLD,IERROR) + call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,& + Previous,572,MPI_COMM_WORLD,STATUS,IERROR) + call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,& + Next,572,MPI_COMM_WORLD,IERROR) + call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,& + Previous,573,MPI_COMM_WORLD,STATUS,IERROR) + call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,& + Next,573,MPI_COMM_WORLD,IERROR) + call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,& + Previous,577,MPI_COMM_WORLD,STATUS,IERROR) + call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,& + Next,577,MPI_COMM_WORLD,IERROR) + call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,& + Previous,579,MPI_COMM_WORLD,STATUS,IERROR) + call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,& + Next,579,MPI_COMM_WORLD,IERROR) + call MPI_Recv(allcart(1,1,1),3*icount*2*nres,& + MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR) + call MPI_Send(allcart(1,1,1),3*icount*2*nres,& + MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR) + jj=jj_old+icount-1 + call dawrite_ccoords(jj_old,jj,icbase) + jj_old=jj+1 +#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,'(e15.5,16i5)') entfac(i) + enddo +#endif + enddo + return + end subroutine receive_and_pass_cconf +#endif +!------------------------------------------------------------------------------ + subroutine daread_ccoords(istart_conf,iend_conf) + +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" +#ifdef MPI + use MPI_data + include "mpif.h" +! include "COMMON.MPI" +#endif +! include "COMMON.CHAIN" +! include "COMMON.CLUSTER" +! include "COMMON.IOUNITS" +! include "COMMON.INTERACT" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" + integer :: istart_conf,iend_conf + integer :: i,j,ij,ii,iii + integer :: len + character(len=16) :: form,acc + character(len=32) :: nam +! +! Read conformations off a DA scratchfile. +! +#ifdef DEBUG + write (iout,*) "DAREAD_COORDS" + write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf + inquire(unit=icbase,name=nam,recl=len,form=form,access=acc) + write (iout,*) "len=",len," form=",form," acc=",acc + write (iout,*) "nam=",nam + call flush(iout) +#endif + do ii=istart_conf,iend_conf + ij = ii - istart_conf + 1 + iii=list_conf(ii) +#ifdef DEBUG + write (iout,*) "Reading binary file, record",iii," ii",ii + call flush(iout) +#endif + 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) +#ifdef DEBUG + write (iout,*) ii,iii,ij,entfac(ii) + 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,nct+nres) + write (iout,'(2e15.5)') entfac(ij) + write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),& + jhpb_all(i,ij),i=1,nss) + call flush(iout) +#endif + enddo + return + end subroutine daread_ccoords +!------------------------------------------------------------------------------ + subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out) + +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" +#ifdef MPI + use MPI_data + include "mpif.h" +! include "COMMON.MPI" +#endif +! include "COMMON.CHAIN" +! include "COMMON.INTERACT" +! include "COMMON.IOUNITS" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.CLUSTER" + integer :: istart_conf,iend_conf + integer :: i,j,ii,ij,iii,unit_out + integer :: len + character(len=16) :: form,acc + character(len=32) :: nam +! +! Write conformations to a DA scratchfile. +! +#ifdef DEBUG + write (iout,*) "DAWRITE_COORDS" + write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf + write (iout,*) "lenrec",lenrec + inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc) + write (iout,*) "len=",len," form=",form," acc=",acc + write (iout,*) "nam=",nam + call flush(iout) +#endif + do ii=istart_conf,iend_conf + iii=list_conf(ii) + ij = ii - istart_conf + 1 +#ifdef DEBUG + write (iout,*) "Writing binary file, record",iii," ii",ii + call flush(iout) +#endif + 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) +#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,& + nct+nres) + write (iout,'(2e15.5)') entfac(ij) + write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,& + nss_all(ij)) + call flush(iout) +#endif + enddo + return + end subroutine dawrite_ccoords +!----------------------------------------------------------------------------- +! readrtns.F +!----------------------------------------------------------------------------- + subroutine read_control +! +! Read molecular data +! + use energy_data, only: rescale_mode,distchainmax,ipot !,temp0 + use control_data, only: titel,outpdb,outmol2,refstr,pdbref,& + iscode,symetr,punch_dist,print_dist,nstart,nend,& + caonly,iopt,efree,lprint_cart,lprint_int +! implicit none +! include 'DIMENSIONS' +! include 'sizesclu.dat' +! include 'COMMON.IOUNITS' +! include 'COMMON.TIME1' +! include 'COMMON.SBRIDGE' +! include 'COMMON.CONTROL' +! include 'COMMON.CLUSTER' +! include 'COMMON.CHAIN' +! include 'COMMON.HEADER' +! include 'COMMON.FFIELD' +! include 'COMMON.FREE' +! include 'COMMON.INTERACT' + character(len=320) :: controlcard !,ucase +!#ifdef MPL +! include 'COMMON.INFO' +!#endif + integer :: i + + read (INP,'(a80)') titel + call card_concat(controlcard,.true.) + + call readi(controlcard,'NRES',nres,0) + +! call alloc_clust_arrays + allocate(rcutoff(max_cut+1)) !(max_cut+1) + allocate(beta_h(maxT)) !(maxT) + allocate(mult(nres)) !(maxres) + + + call readi(controlcard,'RESCALE',rescale_mode,2) + call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0) + write (iout,*) "DISTCHAINMAX",distchainmax + 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) + 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,'SYM',symetr,1) + write (iout,*) 'sym', symetr + call readi(controlcard,'NSTART',nstart,0) + call readi(controlcard,'NEND',nend,0) + call reada(controlcard,'ECUT',ecut,10.0d0) + call reada(controlcard,'PROB',prob_limit,0.99d0) + write (iout,*) "Probability limit",prob_limit + 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 + call readi(controlcard,'NTEMP',nT,1) + write (iout,*) "nT",nT +!el call reada(controlcard,'TEMP0',temp0,300.0d0) !el + call multreada(controlcard,'TEMPER',beta_h,nT,300.0d0) + write (iout,*) "nT",nT + write (iout,*) 'beta_h',(beta_h(i),i=1,nT) + do i=1,nT + beta_h(i)=1.0d0/(1.987D-3*beta_h(i)) + enddo + write (iout,*) 'beta_h',(beta_h(i),i=1,nT) + lprint_cart=index(controlcard,"PRINT_CART") .gt.0 + lprint_int=index(controlcard,"PRINT_INT") .gt.0 + if (min_var) iopt=1 + return + end subroutine read_control +!----------------------------------------------------------------------------- + subroutine molread +! +! Read molecular data. +! + use geometry_data, only: nsup,cref,nres0,nstart_sup,nstart_seq,dc + use energy_data!, only: wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,& +! wang,wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,& +! wturn3,wturn4,wturn6,wvdwpp,weights + use control_data, only: titel,nstart,nend,pdbref,refstr,iscode,& + indpdb + use geometry, only: chainbuild,alloc_geo_arrays + use energy, only: alloc_ener_arrays + use control, only: rescode,setup_var,init_int_table + use conform_compar, only: contact +! implicit none +! 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.CONTACTS' +! include 'COMMON.TIME1' +!#ifdef MPL +! include 'COMMON.INFO' +!#endif + character(len=4) :: sequence(nres) !(maxres) + character(len=800) :: weightcard +! integer rescode + real(kind=8) :: x(6*nres) !(maxvar) + integer :: itype_pdb(nres) !(maxres) +! logical seq_comp + integer :: i,j,kkk +! +! Body +! +!el allocate(weights(n_ene)) + allocate(weights(max_ene)) + call alloc_geo_arrays + call alloc_ener_arrays +!----------------------------- + allocate(c(3,2*nres+2)) !(3,maxres2+2) maxres2=2*maxres + allocate(dc(3,0:2*nres+2)) !(3,0:maxres2) + allocate(itype(nres+2)) !(maxres) + allocate(itel(nres+2)) + + do i=1,2*nres+2 + do j=1,3 + c(j,i)=0 + dc(j,i)=0 + enddo + enddo + do i=1,nres+2 + itype(i)=0 + itel(i)=0 + enddo +!-------------------------- +! Read weights of the subsequent energy terms. + call card_concat(weightcard,.true.) + call reada(weightcard,'WSC',wsc,1.0d0) + call reada(weightcard,'WLONG',wsc,wsc) + call reada(weightcard,'WSCP',wscp,1.0d0) + 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,'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) + 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) !!! el + if (index(weightcard,'SOFT').gt.0) ipot=6 +! 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 +!el weights(19)=wsccor !!!!!!!!!!!!!!!! + weights(21)=wsccor + write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,& + wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wturn3,& + wturn4,wturn6,wsccor + 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)'/ & + 'WTURN3= ',f10.6,' (turns, 3rd order)'/ & + 'WTURN4= ',f10.6,' (turns, 4th 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' + 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 + 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 flush(iout) + print *,'indpdb=',indpdb,' pdbref=',pdbref + +! Read sequence if not taken from the pdb file. + 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 +! 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) + + do i=1,nres +#ifdef PROCOR + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then +#else + if (itype(i).eq.ntyp1) 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 + write (iout,*) "ITEL" + do i=1,nres-1 + write (iout,*) i,itype(i),itel(i) + enddo + + print *,'Call Read_Bridge.' + call read_bridge + nnt=1 + nct=nres + 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 (pdbref) then +! read(inp,'(a)') pdbfile +! write (iout,'(2a)') 'PDB data will be read from file ',pdbfile +! open(ipdbin,file=pdbfile,status='old',err=33) +! goto 34 +! 33 write (iout,'(a)') 'Error opening PDB file.' +! stop +! 34 continue +! print *,'Begin reading pdb data' +! call readpdb +! print *,'Finished reading pdb data' +! write (iout,'(a,i3,a,i3)')'nsup=',nsup,' nstart_sup=',nstart_sup +! do i=1,nres +! itype_pdb(i)=itype(i) +! enddo +! close (ipdbin) +! 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 +! write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup, +! & ' nstart_seq=',nstart_seq +! endif +write(iout,*)"przed ini_int_tab" + call init_int_table +write(iout,*)"po ini_int_tab" +write(iout,*)"przed setup var" + call setup_var +write(iout,*)"po setup var" + write (iout,*) "molread: REFSTR",refstr + if (refstr) then + if (.not.pdbref) then + call read_angles(inp,*38) + goto 39 + 38 write (iout,'(a)') 'Error reading reference structure.' +#ifdef MPL + call mp_stopall(Error_Msg) +#else + stop 'Error reading reference structure' +#endif + 39 call chainbuild + nstart_sup=nnt + nstart_seq=nnt + nsup=nct-nnt+1 + kkk=1 + do i=1,2*nres + do j=1,3 + cref(j,i,kkk)=c(j,i) + enddo + enddo + endif + call contact(.true.,ncont_ref,icont_ref) + endif + return + end subroutine molread +!----------------------------------------------------------------------------- + subroutine openunits +! implicit none +! include 'DIMENSIONS' + use control_data, only: from_cx,from_bx,from_cart +#ifdef MPI + use MPI_data + include "mpif.h" + character(len=3) :: liczba +! include "COMMON.MPI" +#endif +! include 'COMMON.IOUNITS' +! include 'COMMON.CONTROL' + integer :: lenpre,lenpot !,ilen +! external ilen + character(len=16) :: cformat,cprint +! character(len=16) ucase + integer :: lenint,lenout + call getenv('INPUT',prefix) + call getenv('OUTPUT',prefout) + call getenv('INTIN',prefintin) + call getenv('COORD',cformat) + call getenv('PRINTCOOR',cprint) + call getenv('SCRATCHDIR',scratchdir) + from_bx=.true. + from_cx=.false. + if (index(ucase(cformat),'CX').gt.0) then + from_cx=.true. + from_bx=.false. + endif + from_cart=.true. + lenpre=ilen(prefix) + lenout=ilen(prefout) + lenint=ilen(prefintin) +! Get the names and open the input files + open (inp,file=prefix(:ilen(prefix))//'.inp',status='old') +#ifdef MPI + write (liczba,'(bz,i3.3)') me + outname=prefout(:lenout)//'_clust.out_'//liczba +#else + outname=prefout(:lenout)//'_clust.out' +#endif + if (from_bx) then + intinname=prefintin(:lenint)//'.bx' + else if (from_cx) then + intinname=prefintin(:lenint)//'.cx' + else + intinname=prefintin(:lenint)//'.int' + endif + rmsname=prefintin(:lenint)//'.rms' + open (jplot,file=prefout(:ilen(prefout))//'.tex',& + status='unknown') + open (jrms,file=rmsname,status='unknown') + open(iout,file=outname,status='unknown') +! Get parameter filenames and open the parameter files. + call getenv('BONDPAR',bondname) + open (ibond,file=bondname,status='old') + call getenv('THETPAR',thetname) + open (ithep,file=thetname,status='old') + call getenv('ROTPAR',rotname) + open (irotam,file=rotname,status='old') + call getenv('TORPAR',torname) + open (itorp,file=torname,status='old') + call getenv('TORDPAR',tordname) + open (itordp,file=tordname,status='old') + call getenv('FOURIER',fouriername) + open (ifourier,file=fouriername,status='old') + call getenv('ELEPAR',elename) + open (ielep,file=elename,status='old') + call getenv('SIDEPAR',sidename) + open (isidep,file=sidename,status='old') + call getenv('SIDEP',sidepname) + open (isidep1,file=sidepname,status="old") + call getenv('SCCORPAR',sccorname) + open (isccor,file=sccorname,status="old") +#ifndef OLDSCP +! +! 8/9/01 In the newest version SCp interaction constants are read from a file +! Use -DOLDSCP to use hard-coded constants instead. +! + call getenv('SCPPAR',scpname) + open (iscpp,file=scpname,status='old') +#endif + return + end subroutine openunits +!----------------------------------------------------------------------------- +! geomout.F +!----------------------------------------------------------------------------- + subroutine pdboutC(etot,rmsd,tytul) + + use energy_data, only: ihpb,jhpb,itype +! 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.TEMPFAC' + character(len=50) :: tytul + character(len=1) :: chainid(10)=(/'A','B','C','D','E','F',& + 'G','H','I','J'/) + integer :: ica(nres) + real(kind=8) :: etot,rmsd + integer :: iatom,ichain,ires,i,j,iti + + write (ipdb,'(3a,1pe15.5,a,0pf7.2)') 'REMARK ',tytul(:20),& + ' ENERGY ',etot,' RMS ',rmsd + iatom=0 + ichain=1 + ires=0 + do i=nnt,nct + iti=itype(i) + if (iti.eq.ntyp1) then + ichain=ichain+1 + ires=0 + write (ipdb,'(a)') 'TER' + else + ires=ires+1 + iatom=iatom+1 + ica(i)=iatom + write (ipdb,10) iatom,restyp(iti),chainid(ichain),& + ires,(c(j,i),j=1,3),1.0d0,tempfac(1,i) + if (iti.ne.10) then + iatom=iatom+1 + write (ipdb,20) iatom,restyp(iti),chainid(ichain),& + ires,(c(j,nres+i),j=1,3),1.0d0,tempfac(2,i) + endif + endif + enddo + write (ipdb,'(a)') 'TER' + do i=nnt,nct-1 + 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.ntyp1) then + write (ipdb,30) ica(i),ica(i+1),ica(i)+1 + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then + write (ipdb,30) ica(i),ica(i)+1 + endif + enddo + if (itype(nct).ne.10) then + 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 + enddo + write (ipdb,'(a6)') 'ENDMDL' + 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,2f6.2) + 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,2f6.2) + 30 FORMAT ('CONECT',8I5) + return + end subroutine pdboutC +!----------------------------------------------------------------------------- + subroutine cartout(igr,i,etot,free,rmsd,plik) +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'sizesclu.dat' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.VAR' +! include 'COMMON.LOCAL' +! include 'COMMON.INTERACT' +! include 'COMMON.NAMES' +! include 'COMMON.GEO' +! include 'COMMON.CLUSTER' + integer :: igr,i,j,k + real(kind=8) :: etot,free,rmsd + character(len=80) :: plik + open (igeom,file=plik,position='append') + write (igeom,'(2e15.5,f10.5,$)') etot,free,rmsd + write (igeom,'(i4,$)') & + nss_all(i),(ihpb_all(j,i),jhpb_all(j,i),j=1,nss_all(i)) + write (igeom,'(i10)') iscore(i) + write (igeom,'(8f10.5)') & + ((allcart(k,j,i),k=1,3),j=1,nres),& + ((allcart(k,j+nres,i),k=1,3),j=nnt,nct) + return + end subroutine cartout +!------------------------------------------------------------------------------ +! subroutine alloc_clust_arrays(n_conf) + +! integer :: n_conf +!COMMON.CLUSTER +! common /clu/ +! allocate(diss(maxdist)) !(maxdist) +!el allocate(energy(0:maxconf),totfree(0:maxconf)) !(0:maxconf) +! allocatable :: enetb !(max_ene,maxstr_proc) +!el allocate(entfac(maxconf)) !(maxconf) +! allocatable :: totfree_gr !(maxgr) +!el allocate(rcutoff(max_cut+1)) !(max_cut+1) +! common /clu1/ +! allocatable :: licz,iass !(maxgr) +! allocatable :: nconf !(maxgr,maxingr) +! allocatable :: iass_tot !(maxgr,max_cut) +! allocatable :: list_conf !(maxconf) +! common /alles/ +!el allocatable :: allcart !(3,maxres2,maxstr_proc) +!el allocate(rmstb(maxconf)) !(maxconf) +!el allocate(mult(nres)) !(maxres) +!el allocatable :: nss_all !(maxstr_proc) +!el allocatable :: ihpb_all,jhpb_all !(maxss,maxstr_proc) +! allocate(icc(n_conf),iscore(n_conf)) !(maxconf) +!COMMON.TEMPFAC +! common /factemp/ +! allocatable :: tempfac !(2,maxres) +!COMMON.FREE +! common /free/ +!el allocate(beta_h(maxT)) !(maxT) + +! end subroutine alloc_clust_arrays +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module io_clust diff --git a/source/cluster/main_clust.F b/source/cluster/main_clust.F new file mode 100644 index 0000000..15e0bd0 --- /dev/null +++ b/source/cluster/main_clust.F @@ -0,0 +1,449 @@ +C +C Program to cluster united-residue MCM results. +C + implicit none + include 'DIMENSIONS' + include 'sizesclu.dat' +#ifdef MPI + include "mpif.h" + integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) + include "COMMON.MPI" +#endif + include 'COMMON.TIME1' + include 'COMMON.INTERACT' + include 'COMMON.NAMES' + include 'COMMON.GEO' + include 'COMMON.HEADER' + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.VAR' + include 'COMMON.CLUSTER' + include 'COMMON.IOUNITS' + include 'COMMON.FREE' + logical printang(max_cut) + integer printpdb(max_cut) + integer printmol2(max_cut) + character*240 lineh + REAL CRIT(maxconf),MEMBR(maxconf) + REAL CRITVAL(maxconf-1) + 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 + 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,kkk + double precision t1,t2,tcpu,difconf + + double precision varia(maxvar) + double precision hrtime,mintime,sectime + logical eof +#ifdef MPI + call MPI_Init( IERROR ) + call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR ) + call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR ) + Master = 0 + if (ierror.gt.0) then + write(iout,*) "SEVERE ERROR - Can't initialize MPI." + call mpi_finalize(ierror) + stop + endif + if (nprocs.gt.MaxProcs+1) then + write (2,*) "Error - too many processors", + & nprocs,MaxProcs+1 + write (2,*) "Increase MaxProcs and recompile" + call MPI_Finalize(IERROR) + stop + endif +#endif + + call initialize + call openunits + call parmread + call read_control + call molread +c if (refstr) call read_ref_structure(*30) + do i=1,nres + phi(i)=0.0D0 + theta(i)=0.0D0 + alph(i)=0.0D0 + omeg(i)=0.0D0 + enddo +c write (iout,*) "Before permut" +c write (iout,*) "symetr", symetr +c call flush(iout) + call permut(symetr) +c write (iout,*) "after permut" +c call flush(iout) + print *,'MAIN: nnt=',nnt,' nct=',nct + + DO I=1,NCUT + PRINTANG(I)=.FALSE. + PRINTPDB(I)=0 + printmol2(i)=0 + IF (RCUTOFF(I).LT.0.0) THEN + RCUTOFF(I)=ABS(RCUTOFF(I)) + PRINTANG(I)=.TRUE. + PRINTPDB(I)=outpdb + printmol2(i)=outmol2 + ENDIF + ENDDO + 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 + DO I=1,NRES-3 + MULT(I)=1 + ENDDO + do i=1,maxconf + list_conf(i)=i + enddo + call read_coords(ncon,*20) + write (iout,*) 'from read_coords: ncon',ncon + + write (iout,*) "nT",nT + do iT=1,nT + write (iout,*) "iT",iT +#ifdef MPI + call work_partition(.true.,ncon) +#endif + + call probabl(iT,ncon_work,ncon,*20) + + if (ncon_work.lt.2) then + write (iout,*) "Too few conformations; clustering skipped" + exit + endif +#ifdef MPI + ndis=ncon_work*(ncon_work-1)/2 + call work_partition(.true.,ndis) +#endif + + DO I=1,NCON_work + ICC(I)=I + ENDDO + WRITE (iout,'(A80)') TITEL + t1=tcpu() +C +C CALCULATE DISTANCES +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 + 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,kkk)=c(l,k) + enddo + enddo + DO J=I+1,NCON_work + IND=IOFFSET(NCON_work,I,J) +#ifdef MPI + if (ind.ge.indstart(me) .and. ind.le.indend(me)) then +#endif + ind1=ind1+1 + DISS(IND1)=DIFCONF(I,J) +c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND) +#ifdef MPI + endif +#endif + ENDDO + ENDDO + t2=tcpu() + WRITE (iout,'(/a,1pe14.5,a/)') + & 'Time for distance calculation:',T2-T1,' sec.' + t1=tcpu() + PRINT '(a)','End of distance computation' + +#ifdef MPI + 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') + do i=1,ndis + write(80) diss(i) + enddo + if (punch_dist) then + do i=1,ncon_work-1 + do j=i+1,ncon_work + IND=IOFFSET(NCON,I,J) + write (jrms,'(2i5,2f10.5)') i,j,diss(IND), + & energy(j)-energy(i) + enddo + enddo + endif +C +C Print out the RMS deviation matrix. +C + if (print_dist) CALL DISTOUT(NCON_work) +C +C call hierarchical clustering HC from F. Murtagh +C + N=NCON_work + LEN = (N*(N-1))/2 + write(iout,*) "-------------------------------------------" + write(iout,*) "HIERARCHICAL CLUSTERING using" + if (iopt.eq.1) then + write(iout,*) "WARD'S MINIMUM VARIANCE METHOD" + elseif (iopt.eq.2) then + write(iout,*) "SINGLE LINK METHOD" + elseif (iopt.eq.3) then + write(iout,*) "COMPLETE LINK METHOD" + elseif (iopt.eq.4) then + write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD" + elseif (iopt.eq.5) then + write(iout,*) "MCQUITTY'S METHOD" + elseif (iopt.eq.6) then + write(iout,*) "MEDIAN (GOWER'S) METHOD" + elseif (iopt.eq.7) then + write(iout,*) "CENTROID METHOD" + else + write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7" + write(*,*) "IOPT=",iopt," IS INVALID, use 1-7" + stop + endif + write(iout,*) + write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching" + write(iout,*) "February 1986" + write(iout,*) "References:" + write(iout,*) "1. Multidimensional clustering algorithms" + write(iout,*) " Fionn Murtagh" + write(iout,*) " Vienna : Physica-Verlag, 1985." + write(iout,*) "2. Multivariate data analysis" + write(iout,*) " Fionn Murtagh and Andre Heck" + write(iout,*) " Kluwer Academic Publishers, 1987" + write(iout,*) "-------------------------------------------" + write(iout,*) + +#ifdef DEBUG + write (iout,*) "The TOTFREE array" + do i=1,ncon_work + write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i) + enddo +#endif + call flush(iout) + CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS) + LEV = N-1 + write (iout,*) "n",n," ncon_work",ncon_work," lev",lev + if (lev.lt.2) then + write (iout,*) "Too few conformations to cluster." + goto 192 + endif + CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) +c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL) + + do i=1,maxgr + licz(i)=0 + enddo + icut=1 + i=1 + NGR=i+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 + + 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) + write (iout,'(a,f8.2)') 'Maximum distance found:', + & CRITVAL(IDUM) + CALL SRTCLUST(ICUT,ncon_work,iT) + CALL TRACK(ICUT) + CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT) + icut=icut+1 + if (icut.gt.ncut) goto 191 + ENDIF + NGR=i+1 + do l=1,maxgr + licz(l)=0 + enddo + 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))) +cd print *,j,iclass(j,i), +cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i))) + enddo + enddo + 191 continue +C + if (plot_tree) then + CALL WRITRACK + CALL PLOTREE + endif +C + t2=tcpu() + WRITE (iout,'(/a,1pe14.5,a/)') + & 'Total time for clustering:',T2-T1,' sec.' + +#ifdef MPI + endif +#endif + 192 continue + enddo +C + close(icbase,status="delete") +#ifdef MPI + call MPI_Finalize(MPI_COMM_WORLD,IERROR) +#endif + stop '********** Program terminated normally.' + 20 write (iout,*) "Error reading coordinates" +#ifdef MPI + call MPI_Finalize(MPI_COMM_WORLD,IERROR) +#endif + stop + 30 write (iout,*) "Error reading reference structure" +#ifdef MPI + call MPI_Finalize(MPI_COMM_WORLD,IERROR) +#endif + stop + end +c--------------------------------------------------------------------------- + double precision function difconf(icon,jcon) + implicit none + include 'DIMENSIONS' + include 'sizesclu.dat' + include 'COMMON.CONTROL' + include 'COMMON.CLUSTER' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.VAR' + include 'COMMON.IOUNITS' + 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 iaperm,ibezperm,run + double precision rms,rmsmina +c write (iout,*) "tu dochodze" + rmsmina=10d10 + nperm=1 + do i=1,symetr + nperm=i*nperm + enddo +c write (iout,*) "nperm",nperm + call permut(symetr) +c write (iout,*) "tabperm", tabperm(1,1) + do kkk=1,nperm + if (lside) then + ii=0 + chalen=int((nend-nstart+2)/symetr) + do run=1,symetr + do i=nstart,(nstart+chalen-1) + zzz=tabperm(kkk,run) +c write (iout,*) "tutaj",zzz + ii=ii+1 + iaperm=(zzz-1)*chalen+i + ibezperm=(run-1)*chalen+i + do j=1,3 + xx(j,ii)=allcart(j,iaperm,jcon) + yy(j,ii)=cref(j,ibezperm,kkk) + enddo + enddo + enddo + do run=1,symetr + do i=nstart,(nstart+chalen-1) + zzz=tabperm(kkk,run) + ii=ii+1 + iaperm=(zzz-1)*chalen+i + ibezperm=(run-1)*chalen+i +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,kkk) + enddo + enddo +c endif + enddo + call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv) + else + chalen=int((nct-nnt+2)/symetr) + do run=1,symetr + do i=nnt,(nnt+chalen-1) + zzz=tabperm(kkk,run) +c write (iout,*) "tu szukaj", zzz,run,kkk + iaperm=(zzz-1)*chalen+i + ibezperm=(run-1)*chalen+i +c do i=nnt,nct + do j=1,3 + c(j,i)=allcart(j,iaperm,jcon) + enddo + enddo + enddo + call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1, + & przes, + & obrot,non_conv) + endif + if (rms.lt.0.0) then + print *,'error, rms^2 = ',rms,icon,jcon + stop + endif + if (non_conv) print *,non_conv,icon,jcon + if (rmsmina.gt.rms) rmsmina=rms + enddo + difconf=dsqrt(rmsmina) + RETURN + END +C------------------------------------------------------------------------------ + subroutine distout(ncon) + implicit none + include 'DIMENSIONS' + include 'sizesclu.dat' + integer ncol,ncon + parameter (ncol=10) + include 'COMMON.IOUNITS' + include 'COMMON.CLUSTER' + integer i,j,k,jlim,jlim1,nlim,ind,ioffset + real*4 b + dimension b(ncol) + write (iout,'(a)') 'The distance matrix' + do 1 i=1,ncon,ncol + nlim=min0(i+ncol-1,ncon) + write (iout,1000) (k,k=i,nlim) + write (iout,'(8h--------,10a)') ('-------',k=i,nlim) + 1000 format (/8x,10(i4,3x)) + 1020 format (/1x,80(1h-)/) + do 2 j=i,ncon + jlim=min0(j,nlim) + if (jlim.eq.j) then + b(jlim-i+1)=0.0d0 + jlim1=jlim-1 + else + jlim1=jlim + endif + do 3 k=i,jlim1 + if (j.lt.k) then + IND=IOFFSET(NCON,j,k) + else + IND=IOFFSET(NCON,k,j) + endif + 3 b(k-i+1)=diss(IND) + write (iout,1010) j,(b(k),k=1,jlim-i+1) + 2 continue + 1 continue + 1010 format (i5,3x,10(f6.2,1x)) + return + end diff --git a/source/cluster/probabl.f90 b/source/cluster/probabl.f90 new file mode 100644 index 0000000..4e5d092 --- /dev/null +++ b/source/cluster/probabl.f90 @@ -0,0 +1,361 @@ + module probability +!----------------------------------------------------------------------------- + use clust_data + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!---------------------------------------------------------------------------- +! probabl.f90 +!---------------------------------------------------------------------------- + subroutine probabl(ib,nlist,ncon,*) +! construct the conformational ensembles at REMD temperatures +! implicit none +! include "DIMENSIONS" +! include "sizesclu.dat" + use io_units + use io_clust, only: daread_ccoords + use geometry_data, only: nres,c + use energy_data, only: nss,ihpb,jhpb,max_ene + use geometry, only: int_from_cart1 + use energy, only: etotal,rescale_weights + use energy, only: rescale_mode,enerprint,weights +#ifdef MPI + use MPI_data + include "mpif.h" +! include "COMMON.MPI" + integer :: ierror,errcode !,status(MPI_STATUS_SIZE) +#endif +! include "COMMON.IOUNITS" +! include "COMMON.FREE" +! include "COMMON.FFIELD" +! include "COMMON.INTERACT" +! include "COMMON.SBRIDGE" +! include "COMMON.CHAIN" +! include "COMMON.CLUSTER" + real(kind=4) :: csingle(3,2*nres) + real(kind=8) :: fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl,& + eprim,ebis,temper,kfac=2.4d0,T0=300.0d0 + real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ebe,etors,escloc,& + ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,& + eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,& + evdw_t + integer :: i,ii,ik,iproc,iscor,j,k,l,ib,nlist,ncon + real(kind=8) :: qfree,sumprob,eini,efree,rmsdev + character(len=80) :: bxname + character(len=2) :: licz1 + character(len=5) :: ctemper +! integer ilen +! external ilen + real(kind=4) :: Fdimless(maxconf),Fdimless_(maxconf) + real(kind=8) :: totfree_(0:maxconf),entfac_(maxconf) + real(kind=8) :: energia(0:max_ene) + integer,dimension(0:nprocs) :: scount_ + + do i=1,ncon + list_conf(i)=i + enddo +! do i=1,ncon +! write (iout,*) i,list_conf(i) +! enddo +#ifdef MPI + write (iout,*) me," indstart",indstart(me)," indend",indend(me) + call daread_ccoords(indstart(me),indend(me)) +#endif +! write (iout,*) "ncon",ncon + temper=1.0d0/(beta_h(ib)*1.987D-3) +!elwrite(iout,*)"rescale_mode", rescale_mode +! write (iout,*) "ib",ib," beta_h",beta_h(ib)," temper",temper +! quot=1.0d0/(T0*beta_h(ib)*1.987D-3) +! quotl=1.0d0 +! kfacl=1.0d0 +! do l=1,5 +! quotl1=quotl +! quotl=quotl*quot +! kfacl=kfacl*kfac +! fT(l)=kfacl/(kfacl-1.0d0+quotl) +! enddo +! EL start old rescale------------------------------- +! if (rescale_mode.eq.1) then +! quot=1.0d0/(T0*beta_h(ib)*1.987D-3) +! quotl=1.0d0 +! kfacl=1.0d0 +! do l=1,5 +! quotl1=quotl +! quotl=quotl*quot +! kfacl=kfacl*kfac +! fT(l)=kfacl/(kfacl-1.0d0+quotl) +! 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=1.0d0/(T0*beta_h(ib)*1.987D-3) +! quotl=1.0d0 +! do l=1,5 +! quotl=quotl*quot +! fT(l)=1.12692801104297249644d0/ & +! dlog(dexp(quotl)+dexp(-quotl)) +! enddo +!el write (iout,*) 1.0d0/(beta_h(ib)*1.987D-3) +!c call flush(iout) +!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 +! endif +!EL end old rescele---------------------- +! + call rescale_weights(1.0d0/(beta_h(ib)*1.987D-3)) + +#ifdef MPI + do i=1,scount(me) + ii=i+indstart(me)-1 +#else + do i=1,ncon + ii=i +#endif +! write (iout,*) "i",i," ii",ii +! call flush(iout) + 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) + enddo + enddo + do k=1,3 + c(k,nres+1)=c(k,1) + c(k,nres+nres)=c(k,nres) + enddo +!el do j=1,2*nres +! do k=1,3 +!write(iout,*)"c, k, j",k,j,c(k,j) +! enddo +!el enddo + nss=nss_all(i) + do j=1,nss + ihpb(j)=ihpb_all(j,i) + jhpb(j)=jhpb_all(j,i) + enddo + call int_from_cart1(.false.) +! call etotal(energia(0),fT) + call etotal(energia) + totfree(i)=energia(0) +! 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) +! call enerprint(energia) +! call pdbout(totfree(i),16,i) +#ifdef DEBUG + write (iout,*) i," energia",(energia(j),j=0,21) + write (iout,*) "etot", etot +! write (iout,*) "ft(6)", ft(6) +#endif + do k=1,max_ene + enetb(k,i)=energia(k) + enddo + endif +!el evdw=enetb(1,i) +! write (iout,*) evdw + etot=energia(0) +#ifdef SCP14 +!el evdw2_14=enetb(17,i) + evdw2_14=enetb(18,i) + evdw2=enetb(2,i)+evdw2_14 +#else + evdw2=enetb(2,i) + evdw2_14=0.0d0 +#endif +#ifdef SPLITELE + ees=enetb(3,i) + evdw1=enetb(16,i) +#else + ees=enetb(3,i) + evdw1=0.0d0 +#endif + ecorr=enetb(4,i) + ecorr5=enetb(5,i) + ecorr6=enetb(6,i) + eel_loc=enetb(7,i) + eello_turn3=enetb(8,i) + eello_turn4=enetb(9,i) + eturn6=enetb(10,i) + ebe=enetb(11,i) + escloc=enetb(12,i) + etors=enetb(13,i) + etors_d=enetb(14,i) + ehpb=enetb(15,i) +! estr=enetb(18,i) + estr=enetb(17,i) +! esccor=enetb(19,i) + esccor=enetb(21,i) +! edihcnstr=enetb(20,i) + edihcnstr=enetb(19,i) +!#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 +!#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 +!#endif +!#ifdef DEBUG +! write (iout,*) "etot2", etot +! write (iout,*) "evdw", wsc, evdw,evdw_t +! write (iout,*) "evdw2", wscp, evdw2 +! write (iout,*) "welec", ft(1),welec,ees +! write (iout,*) "evdw1", wvdwpp,evdw1 +! write (iout,*) "ebe",ebe,wang +!#endif + Fdimless(i)=beta_h(ib)*etot+entfac(ii) + totfree(i)=etot +#ifdef DEBUG + write (iout,*) "fdim calc", i,ii,ib,& + 1.0d0/(1.987d-3*beta_h(ib)),totfree(i),& + entfac(ii),Fdimless(i) +#endif + Fdimless_(i)=Fdimless(i) + totfree_(i)=totfree(i) + call enerprint(energia(0)) !el + enddo ! i + + do i=1,maxconf + entfac_(i)=entfac(i) + enddo + do i=0,nprocs + scount_(i)=scount(i) + enddo + +#ifdef MPI + 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),& + 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),& + scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master,& + MPI_COMM_WORLD, IERROR) + + if (me.eq.Master) then +#endif +#ifdef DEBUG + write (iout,*) "The FDIMLESS array before sorting" + do i=1,ncon + write (iout,*) i,fdimless(i) + enddo +#endif + call mysort1(ncon,Fdimless,list_conf) +#ifdef DEBUG + write (iout,*) "The FDIMLESS array after sorting" + do i=1,ncon + write (iout,*) i,list_conf(i),fdimless(i) + enddo +#endif + do i=1,ncon + totfree(i)=fdimless(i) + enddo + qfree=0.0d0 + do i=1,ncon + qfree=qfree+exp(-fdimless(i)+fdimless(1)) +! write (iout,*) "fdimless", fdimless(i) + enddo + write (iout,*) "qfree",qfree !d + nlist=1 + sumprob=0.0 + write (iout,*) "ncon", ncon,maxstr_proc + do i=1,min0(ncon,maxstr_proc)-1 + sumprob=sumprob+exp(-fdimless(i)+fdimless(1))/qfree +#ifdef DEBUG + write (iout,*) 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 +#endif + if (sumprob.gt.prob_limit) goto 122 +! if (sumprob.gt.1.00d0) goto 122 + nlist=nlist+1 + enddo + 122 continue +#ifdef MPI + endif + call MPI_Bcast(nlist, 1, MPI_INTEGER, Master, MPI_COMM_WORLD, & + IERROR) + call MPI_Bcast(list_conf,nlist,MPI_INTEGER,Master,MPI_COMM_WORLD,& + IERROR) +! do iproc=0,nprocs +! write (iout,*) "iproc",iproc," indstart",indstart(iproc), +! & " indend",indend(iproc) +! enddo +#endif +!write(iout,*)"koniec probabl" + return + end subroutine probabl +!-------------------------------------------------- + subroutine mysort1(n, x, ipermut) +! implicit none + integer :: i,j,imax,ipm,n + real(kind=4) :: x(n) + integer :: ipermut(n) + real(kind=4) :: xtemp + do i=1,n + xtemp=x(i) + imax=i + do j=i+1,n + if (x(j).lt.xtemp) then + imax=j + xtemp=x(j) + endif + enddo + x(imax)=x(i) + x(i)=xtemp + ipm=ipermut(imax) + ipermut(imax)=ipermut(i) + ipermut(i)=ipm + enddo + return + end subroutine mysort1 +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module probability diff --git a/source/cluster/proc_proc.c b/source/cluster/proc_proc.c new file mode 100644 index 0000000..f023520 --- /dev/null +++ b/source/cluster/proc_proc.c @@ -0,0 +1,140 @@ +#include +#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/cluster/track.f90 b/source/cluster/track.f90 new file mode 100644 index 0000000..542da6a --- /dev/null +++ b/source/cluster/track.f90 @@ -0,0 +1,306 @@ + module tracking +!------------------------------------------------------------------------------ + use clust_data + implicit none +!------------------------------------------------------------------------------ +! COMMON /HISTORY/ + integer :: NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) +! COMMON /PREVIOUS/ + integer :: NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) +!------------------------------------------------------------------------------ +! +! +!------------------------------------------------------------------------------ + contains +!------------------------------------------------------------------------------ + SUBROUTINE TRACK(ICUT) +! include 'DIMENSIONS' +! INCLUDE 'sizesclu.dat' +! INCLUDE 'COMMON.CLUSTER' +! COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) +! COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) + integer :: icut,igr,jgr,k,nci1 + IF (ICUT.GT.1) THEN +! Find out what of the previous families the current ones came from. + DO IGR=1,NGR + NCI1=NCONF(IGR,1) + DO JGR=1,NGRP + DO K=1,LICZP(JGR) + IF (NCI1.EQ.NCONFP(JGR,K)) THEN + IBACK(IGR,ICUT)=JGR + GOTO 10 + ENDIF + ENDDO ! K + ENDDO ! JGR + 10 CONTINUE + ENDDO ! IGR + ENDIF ! (ICUT.GT.1) +! Save current partition for subsequent backtracking. + NCUR(ICUT)=NGR + NGRP=NGR + DO IGR=1,NGR + LICZP(IGR)=LICZ(IGR) + DO K=1,LICZ(IGR) + NCONFP(IGR,K)=NCONF(IGR,K) + ENDDO ! K + ENDDO ! IGR + RETURN + END SUBROUTINE TRACK +!------------------------------------------------------------------------------ + SUBROUTINE WRITRACK + + use io_units, only: iout +! include 'DIMENSIONS' +! INCLUDE 'sizesclu.dat' +! INCLUDE 'COMMON.CLUSTER' +! include 'COMMON.IOUNITS' +! COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) +! COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) + integer :: IPART(MAXGR/5,MAXGR/5) + integer :: icut,i,j,k,ncu,ncup,npart +! do icut=2,ncut +! write (iout,'(a,f10.5)') 'Cut-off',rcutoff(icut) +! write (iout,'(16i5)') (iback(k,icut),k=1,ncur(icut)) +! enddo +! +! Print the partition history. +! + DO ICUT=2,NCUT + NCU=NCUR(ICUT) + NCUP=NCUR(ICUT-1) +!d print *,'icut=',icut,' ncu=',ncu,' ncur=',ncur + WRITE(iout,'(A,f10.5,A,f10.5)') & + 'Partition of families obtained at cut-off',RCUTOFF(ICUT-1),& + ' at cut-off',RCUTOFF(ICUT) + DO I=1,NCUP + NPART=0 +!d print *,'i=',i + DO J=1,NCU + IF (IBACK(J,ICUT).EQ.I) THEN + NPART=NPART+1 + IPART(NPART,I)=J + ENDIF +!d print *,'j=',j,' iback=',IBACK(J,ICUT),' npart=',npart + ENDDO ! J + WRITE (iout,'(16I5)') I,(IPART(K,I),K=1,NPART) + ENDDO ! I + ENDDO ! ICUT + RETURN + END SUBROUTINE WRITRACK +!------------------------------------------------------------------------------ + SUBROUTINE PLOTREE + + use io_units, only: jplot + use io_base, only: ilen +! include 'DIMENSIONS' +! INCLUDE 'sizesclu.dat' +! INCLUDE 'COMMON.CLUSTER' +! include 'COMMON.IOUNITS' +! COMMON /HISTORY/ NCUR(MAX_CUT),IBACK(MAXGR,MAX_CUT) +! COMMON /PREVIOUS/ NGRP,LICZP(MAXGR),NCONFP(MAXGR,MAXINGR) + integer,DIMENSION(MAXGR,MAX_CUT) :: Y + integer,DIMENSION(MAXGR,MAX_CUT) :: ITREE,IFIRST,ILAST + integer,dimension(MAXGR) :: IFT,ILT,ITR + CHARACTER(len=32) :: FD + integer :: i,icut,j,k,is,iti,jf1,jf2,jl1,jl2,ncu,ncup,npart + integer :: jr1,jr2,jf11,kl,kf,nnc,iylen,ideltx,idelty + real(kind=8) :: xlen,ylen,xbox,ybox,deltx,yy + real(kind=8) :: ycur,xcur,xdraw,ydraw,delty +!el external ilen +! +! Generate the image of the tree (tentatively for LaTeX picture environment). +! +! +! First untangle the branches of the tree +! + DO I=1,NCUR(1) + ITREE(I,1)=I + ENDDO + DO ICUT=NCUT,2,-1 +! +! Determine the order of families for the (icut)th partition. +! + NCU=NCUR(ICUT) + NCUP=NCUR(ICUT-1) + NPART=0 + DO I=1,NCUP + IS=0 + IF (I.GT.1) ILAST(I-1,ICUT-1)=NPART + DO J=1,NCU + IF (IBACK(J,ICUT).EQ.I) THEN + NPART=NPART+1 + IF (IS.EQ.0) THEN + IS=1 + IFIRST(I,ICUT-1)=NPART + ENDIF + ITREE(NPART,ICUT)=J + ENDIF + ENDDO ! J + ENDDO ! I + ILAST(NCUP,ICUT-1)=NPART +!d print *,'i=',i,' ncup=',ncup,' ncu=',ncu,' npart=',npart + ENDDO ! ICUT +! diagnostic printout +!d do icut=1,ncut +!d write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut) +!d write (iout,*) 'ITREE' +!d write (iout,*) (itree(i,icut),i=1,ncur(icut)) +!d write (iout,*) 'IFIRST, ILAST' +!d write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut)) +!d enddo +! +! Propagate the order of families from cut-off #2 to cut-off #n. +! + DO ICUT=1,NCUT-1 + DO J=1,NCUR(ICUT) + IFT(J)=IFIRST(J,ICUT) + ILT(J)=ILAST(J,ICUT) + ENDDO ! J + DO J=1,NCUR(ICUT+1) + ITR(J)=ITREE(J,ICUT+1) + ENDDO + DO I=1,NCUR(ICUT) + ITI=ITREE(I,ICUT) +! write (iout,*) 'icut=',icut,' i=',i,' iti=',iti +! IF (ITI.NE.I) THEN + JF1=IFT(I) + JF2=IFT(ITI) + JL1=ILT(I) + JL2=ILT(ITI) + JR1=JL1-JF1+1 + JR2=JL2-JF2+1 +!d write (iout,*) 'jf1=',jf1,' jl1=',jl1,' jf2=',jf2, +!d & ' jl2=',jl2 +!d write (iout,*) 'jr1=',jr1,' jr2=',jr2 +! Update IFIRST and ILAST. + ILAST(I,ICUT)=IFIRST(I,ICUT)+JR2-1 + IFIRST(I+1,ICUT)=ILAST(I,ICUT)+1 +! Update ITREE. + JF11=IFIRST(I,ICUT) +!d write(iout,*) 'jf11=',jf11 + DO J=JF2,JL2 +!d write (iout,*) j,JF11+J-JF2,ITR(J) + ITREE(JF11+J-JF2,ICUT+1)=ITR(J) + ENDDO +!d write (iout,*) (ifirst(k,icut),ilast(k,icut),k=1,i) +!d write (iout,*) (itree(k,icut+1),k=1,ilast(i,icut)) +! ENDIF ! (ITI.NE.I) + ENDDO ! I + ENDDO ! ICUT +! diagnostic printout +!d do icut=1,ncut +!d write (iout,*) 'Cut-off',icut,' = ',rcutoff(icut) +!d write (iout,*) 'ITREE' +!d write (iout,*) (itree(i,icut),i=1,ncur(icut)) +!d write (iout,*) 'IFIRST, ILAST' +!d write (iout,*) (ifirst(i,icut),ilast(i,icut),i=1,ncur(icut)) +!d enddo +! +! Generate the y-coordinates of the branches. +! + XLEN=400.0/(ncut-1) + YLEN=600.0 + xbox=xlen/4.0 + deltx=0.5*(xlen-xbox) + NNC=NCUR(NCUT) + ybox=ylen/(2.0*nnc) + DO J=1,NNC + Y(J,NCUT)=J*YLEN/NNC + ENDDO + DO ICUT=NCUT-1,1,-1 + NNC=NCUR(ICUT) + DO J=1,NNC + KF=IFIRST(J,ICUT) + KL=ILAST(J,ICUT) + YY=0.0 + DO K=KF,KL + YY=YY+Y(K,ICUT+1) + ENDDO + Y(J,ICUT)=YY/(KL-KF+1) + ENDDO ! J + ENDDO ! ICUT +! diagnostic output +!d do icut=1,ncut +!d write(iout,*) 'Cut-off=',rcutoff(icut) +!d write(iout,'(8f10.3)') (y(j,icut),j=1,ncur(icut)) +!d enddo +! +! Generate LaTeX script for tree plot +! + iylen=ylen +#ifdef AIX + call fdate_(fd) +#else + call fdate(fd) +#endif + write(jplot,'(80(1h%))') + write(jplot,'(a)') '% LaTeX code for minimal-tree plotting.' + write(jplot,'(3a)') '% Created by UNRES_CLUST on ',& + fd(:ilen(fd)),'.' + write(jplot,'(2a)') '% To change the dimensions use the LaTeX',& + ' \\unitlength=number command.' + write(jplot,'(a)') '% The default dimensions fit an A4 page.' + write(jplot,'(80(1h%))') + write(jplot,'(a,i5,a)') '\\begin{picture}(1,1)(0,',iylen,')' + ycur=ylen+ybox + do icut=ncut,1,-1 + xcur=xlen*(icut-1) + write(jplot,'(a,f6.1,a,f6.1,a,f4.2,a)') & + ' \\put(',xcur,',',ycur,'){',rcutoff(icut),' \\AA}' + enddo ! icut + xcur=0.0 + xdraw=xcur+xbox + nnc=ncur(1) + write(jplot,'(a,i3,a)') '% Begin cut-off',1,'.' + do j=1,nnc + ydraw=y(j,1) + ycur=ydraw-0.5*ybox + ideltx=deltx + write(jplot,'(4(a,f6.1),a,i3,a)') & + ' \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){',& + itree(j,1),'}}' + write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & + ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx,& + ',',0,'){',deltx,'}}' + enddo ! j + do icut=2,ncut + write(jplot,'(a,i3,a)') '% Begin cut-off',icut,'.' + xcur=xlen*(icut-1) + xdraw=xcur-deltx +!d print *,'icut=',icut,' xlen=',xlen,' deltx=',deltx, +!d & ' xcur=',xcur,' xdraw=',xdraw + nnc=ncur(icut) + do j=1,ncur(icut-1) + ydraw=y(ifirst(j,icut-1),icut) + delty=y(ilast(j,icut-1),icut)-y(ifirst(j,icut-1),icut) + idelty=delty + write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & + ' \\put(',xdraw,',',ydraw,'){\\line(',0,& + ',',idelty,'){',delty,'}}' + enddo + do j=1,nnc + xcur=xlen*(icut-1) + xdraw=xcur-deltx + ydraw=y(j,icut) + ycur=ydraw-0.5*ybox + ideltx=deltx + write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & + ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx,& + ',',0,'){',deltx,'}}' + write(jplot,'(4(a,f6.1),a,i3,a)') & + ' \\put(',xcur,',',ycur,'){\\framebox(',xbox,',',ybox,'){',& + itree(j,icut),'}}' + if (icut.lt.ncut) then + xdraw=xcur+xbox + write(jplot,'(2(a,f6.1),2(a,i5),a,f6.1,a)') & + ' \\put(',xdraw,',',ydraw,'){\\line(',ideltx,& + ',',0,'){',deltx,'}}' + endif + enddo ! j + enddo ! icut + write(jplot,'(a)') '\\end{picture}' + RETURN + END SUBROUTINE PLOTREE +!------------------------------------------------------------------------------ +!------------------------------------------------------------------------------ + end module tracking diff --git a/source/cluster/xdrf b/source/cluster/xdrf new file mode 120000 index 0000000..aa19d57 --- /dev/null +++ b/source/cluster/xdrf @@ -0,0 +1 @@ +../xdrf/ \ No newline at end of file diff --git a/source/unres/CSA.f90 b/source/unres/CSA.f90 index 4b5b8f8..66b98ee 100644 --- a/source/unres/CSA.f90 +++ b/source/unres/CSA.f90 @@ -206,8 +206,7 @@ indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),& chacc,iaccn,difmin,denep else - write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,0pf4.1,& - a5,f3.0,1x,a1,i4,0pf8.1,0pf8.1)') & + write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,0pf4.1,a5,f3.0,1x,a1,i4,0pf8.1,0pf8.1)') & indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',& indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),& ' rms ',rmsn(n),' %NC ',pncn(n)*100,& @@ -1439,6 +1438,7 @@ use geometry, only: dist include 'mpif.h' +! use random, only: iran_num,ran_number ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' @@ -4346,6 +4346,7 @@ endif nft00_c=nft nft0i=nft + !cccccccccccccccccccccccccccccccccccccc do while (.not. finished) !cccccccccccccccccccccccccccccccccccccc diff --git a/source/unres/CSA_data.f90 b/source/unres/CSA_data.f90 deleted file mode 100644 index cd5835d..0000000 --- a/source/unres/CSA_data.f90 +++ /dev/null @@ -1,77 +0,0 @@ - module csa_data -!----------------------------------------------------------------------------- -! Maximum number of generated conformations - integer,parameter :: mxio=1000 -! Maximum number of n7 generated conformations - integer,parameter :: mxio2=100 -! Maxmimum number of angles per residue - integer,parameter :: mxang=4 -! Maximum number of chains - integer,parameter :: mxch=1 -!----------------------------------------------------------------------------- -! commom.bank -! common/varin/ - real(kind=8),dimension(:,:,:,:),allocatable :: dihang_in !(mxang,maxres,mxch,mxio) -! common/minvar/ -! real(kind=8),dimension(:,:,:,:),allocatable :: dihang !(mxang,maxres,mxch,mxio) - real(kind=8),dimension(:),allocatable :: rmsn,pncn !(mxio) -! integer,dimension(:),allocatable :: nss_out !(mxio) -! integer,dimension(:,:),allocatable ::iss_out,jss_out !(maxss,mxio) -! common/bank/ - real(kind=8),dimension(:,:,:,:),allocatable :: rvar,bvar!(mxang,maxres,mxch,mxio) - real(kind=8),dimension(:),allocatable :: bene,rene,& - brmsn,rrmsn,bpncn,rpncn !(mxio) - integer,dimension(:),allocatable :: ibank!,is,jbank !(mxio) - real(kind=8) :: cutdif,&!,avedif,difmin,ebmin,ebmax,ebmaxt,& - dele,difcut,rmscut,pnccut -! real(kind=8),dimension(:,:),allocatable :: dij !(mxio,mxio) - integer :: ibmin,ibmax,nbank,ntbank,ntbankm,nconf,iuse,& - nstep,icycle,iseed,iref,nconf_in,ilastnstep,nadd -! common/bank_disulfid/ - integer,dimension(:),allocatable :: bvar_nss,bvar_ns !(mxio) - integer,dimension(:,:),allocatable :: bvar_s !(maxss,mxio) - integer,dimension(:,:,:),allocatable :: bvar_ss !(2,maxss,mxio) -!----------------------------------------------------------------------- -! common.iounits -! I/O units used by the program -!----------------------------------------------------------------------- -! 9/18/99 - unit ifourier and filename fouriername included to identify -! the file from which the coefficients of second-order Fourier expansion -! of the local-interaction energy are read. -! 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) -! included. -!----------------------------------------------------------------------- -! CSA I/O units & files -! common /csafiles/ - character(len=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 /csaunits/ - 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.csa - integer :: irestart,ndiff -! common/alphaa/ -! integer,dimension(:),allocatable :: ngroup !(mxgr) -! integer,dimension(:,:,:),allocatable :: igroup !(3,mxang,mxgr) - integer :: numch -! common/csa_input/ - real(kind=8) :: cut1,cut2,estop - real(kind=8) :: eglob_csa - integer :: jstart,jend,& - n1,n2,n3,n4,n5,n6,n7,n8,n9,n14,n15,n16,n17,n18,n0,& - is1,is2,nseed,ntotal,icmax,nstmax,nran0,nran1,irr - integer :: nglob_csa,nmin_csa -! common/dih_control/ - real(kind=8) :: rdih_bias -! common/diffcuta/ - real(kind=8) :: diffcut -!----------------------------------------------------------------------------- -! Maximum number of groups of angles - integer :: mxgr -!----------------------------------------------------------------------------- - real(kind=8) :: rmsdbc1 -!----------------------------------------------------------------------------- - end module csa_data diff --git a/source/unres/MCM_MD.f90 b/source/unres/MCM_MD.f90 index fe6fbb9..afb31bb 100644 --- a/source/unres/MCM_MD.f90 +++ b/source/unres/MCM_MD.f90 @@ -12,9 +12,15 @@ implicit none !----------------------------------------------------------------------------- +! Max. number of move types in MCM +! integer,parameter :: maxmovetype=4 +!----------------------------------------------------------------------------- ! Max. number of conformations in Master's cache array integer,parameter :: max_cache=10 !----------------------------------------------------------------------------- +! Max. number of stored confs. in MC/MCM simulation +! integer,parameter :: maxsave=20 +!----------------------------------------------------------------------------- ! Number of threads in deformation integer,parameter :: max_thread=4, max_thread2=2*max_thread !----------------------------------------------------------------------------- @@ -28,6 +34,11 @@ ! commom.cache ! common /cache/ integer :: ncache +! integer,dimension(max_cache) :: CachSrc nie używane +! integer,dimension(max_cache) :: isent,iused +! logical :: cache_update +! real(kind=8),dimension(max_cache) :: ecache +! real(kind=8),dimension(:,:),allocatable :: xcache !(maxvar,max_cache) !----------------------------------------------------------------------------- ! common.mce ! common /mce/ @@ -57,7 +68,10 @@ ! integer :: nacc_tot integer,dimension(:),allocatable :: nacc_part !(0:MaxProcs) !el nie uzywane??? ! common /windows/ +! integer :: nwindow +! integer,dimension(:),allocatable :: winstart,winend,winlen !(maxres) ! common /moveID/ +! character(len=16),dimension(-1:MaxMoveType+1) :: MovTypID !(-1:MaxMoveType+1) !------------------------------------------------------------------------------ !... koniecl - the number of bonds to be considered "end bonds" subjected to !... end moves; @@ -1026,6 +1040,7 @@ use control, only:tcpu,ovrtim use regularize_, only:fitsq use compare +! use control ! Does Boltzmann and entropic sampling without energy minimization ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' @@ -2311,6 +2326,8 @@ use compare, only:contact,contact_fract use minimm, only:minimize use regularize_, only:fitsq +! use contact_, only:contact +! use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -2693,6 +2710,7 @@ use MPI_data use minimm, only:minimize +! use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' diff --git a/source/unres/MCM_data.f90 b/source/unres/MCM_data.f90 deleted file mode 100644 index b698318..0000000 --- a/source/unres/MCM_data.f90 +++ /dev/null @@ -1,73 +0,0 @@ - module mcm_data -!----------------------------------------------------------------------------- -! Max. number of stored confs. in MC/MCM simulation - integer,parameter :: maxsave=20 -!----------------------------------------------------------------------------- -! common.mce -! common /mce/ - real(kind=8) :: emin,emax - logical :: ent_read -! common /pool/ - real(kind=8) :: pool_fraction -! common /mce_counters/ - integer :: save_frequency,message_frequency,pool_read_freq,& - pool_save_freq,print_freq -!----------------------------------------------------------------------------- -! commom.mcm -!... Following COMMON block contains general variables controlling the MC/MCM -!... procedure -!----------------------------------------------------------------------------- -! common /mcm/ - real(kind=8) :: Tcur,Tmin,Tmax,TstepH,TstepC,RanFract,& - overlap_cut,e_up,delte,Rbol,betbol - integer :: nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,& - maxrepm,maxoverlap,ntrial,max_mcm_it,ngen,ntherm,nrepm,neneval,& - nsave,nsweep,print_mc - integer,dimension(:),allocatable :: nsave_part !(max_cg_procs) - logical :: print_stat,print_int -!----------------------------------------------------------------------------- -!... The meaning of the above variables is as follows: -!... Tcur,Tmin,Tmax - Current,minimum and maximum temperature, respectively; -!... NstepC,NStepH - Number of cooling and heating steps, respectively; -!... TstepH,TstepC - factors by which T is multiplied in order to be -!... increased or decreased. -!... betbol - Boltzmann's inverse temperature (1/(Rbol*Tcur)); -!... Rbol - the gas constant; -!... RanFract - the chance that a new conformation will be random-generated; -!... maxacc - maximum number of accepted conformations; -!... maxgen,ngen - Maximum and current number of generated conformations; -!... maxtrial,ntrial - maximum number of trials before temperature is increased -!... and current number of trials, respectively; -!... maxrepm,nrepm - maximum number of allowed minima repetition and current -!... number of minima repetitions, respectively; -!... maxoverlap - max. # of overlapping confs generated in a single iteration; -!... neneval - number of energy evaluations; -!... nsave - number of confs. in the backup array; -!... nsweep - the number of macroiterations in generating the distributions. -!------------------------------------------------------------------------------ -!... Following COMMON block contains variables controlling motion. -!------------------------------------------------------------------------------ -! common /move/ - real(kind=8),dimension(:),allocatable :: sumpro_type !(0:MaxMoveType) - integer :: nmove - integer,dimension(:),allocatable :: moves,moves_acc !(-1:MaxMoveType+1) -!... maxgen,ngen - Maximum and current number of generated conformations; -! common /accept_stats/ - integer :: nacc_tot -! common /windows/ - integer :: nwindow - integer,dimension(:),allocatable :: winstart,winend,winlen !(maxres) -! common /moveID/ - character(len=16),dimension(:),allocatable :: MovTypID !(-1:MaxMoveType+1) -!----------------------------------------------------------------------------- -! common.var -! Store the angles and variables corresponding to old conformations (for use -! in MCM). -! common /oldgeo/ - real(kind=8),dimension(:,:),allocatable :: varsave !(maxvar,maxsave)(maxvar=6*maxres) - real(kind=8),dimension(:),allocatable :: esave !(maxsave) - integer,dimension(:),allocatable :: Origin !(maxsave) - integer :: nstore -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module mcm_data diff --git a/source/unres/MD.f90 b/source/unres/MD.f90 index a436a93..c509ee1 100644 --- a/source/unres/MD.f90 +++ b/source/unres/MD.f90 @@ -24,8 +24,18 @@ d_t_work_new,d_af_work,d_as_work,kinetic_force !(MAXRES6) real(kind=8),dimension(:,:),allocatable :: d_t_new,& d_a_old,d_a_short!,d_a !(3,0:MAXRES2) +! real(kind=8),dimension(:),allocatable :: d_a_work !(6*MAXRES) +! real(kind=8),dimension(:,:),allocatable :: Gmat,Ginv,A,& +! Gsqrp,Gsqrm,Gvec !(maxres2,maxres2) +! real(kind=8),dimension(:),allocatable :: Geigen !(maxres2) +! integer :: dimen,dimen1,dimen3 +! integer :: lang,count_reset_moment,count_reset_vel +! logical :: reset_moment,reset_vel,rattle,RESPA ! common /inertia/ ! common /langevin/ +! real(kind=8) :: rwat,etawat,stdfp,cPoise +! real(kind=8),dimension(:),allocatable :: gamsc !(ntyp1) +! real(kind=8),dimension(:),allocatable :: stdfsc !(ntyp) real(kind=8),dimension(:),allocatable :: stdforcp,stdforcsc !(MAXRES) !----------------------------------------------------------------------------- ! 'sizes.i' @@ -149,6 +159,7 @@ use control, only: tcpu use control_data use energy_data +! use io_conf, only:cartprint ! include 'DIMENSIONS' #ifdef MPI include 'mpif.h' @@ -734,7 +745,9 @@ ! The driver for molecular dynamics subroutines !------------------------------------------------ use comm_gucio +! use MPI use control, only:tcpu,ovrtim +! use io_comm, only:ilen use control_data use compare, only:secondary2,hairpin use io, only:cartout,statout @@ -1324,8 +1337,10 @@ ! include 'DIMENSIONS' use comm_gucio use comm_cipiszcze +! use MPI use control, only:tcpu use control_data +! use io_conf, only:cartprint #ifdef MPI include 'mpif.h' integer :: IERROR,ERRCODE @@ -2402,14 +2417,11 @@ endif endif call chainbuild_cart -write(iout,*) "przed kinetic, EK=",EK call kinetic(EK) if (tbf) then call verlet_bath endif -write(iout,*) "dimen3",dimen3,"Rb",Rb,"EK",EK kinetic_T=2.0d0/(dimen3*Rb)*EK -write(iout,*) "kinetic_T",kinetic_T if(me.eq.king.or..not.out1file)then call cartprint call intout @@ -2431,9 +2443,7 @@ write(iout,*) "kinetic_T",kinetic_T #endif potE=potEcomp(0) call cartgrad -write(iout,*) "kinetic_T if large",kinetic_T call lagrangian -write(iout,*) "kinetic_T if large",kinetic_T call max_accel if (amax*d_time .gt. dvmax) then d_time=d_time*dvmax/amax @@ -2504,9 +2514,7 @@ write(iout,*) "kinetic_T if large",kinetic_T #endif #endif call cartgrad -write(iout,*) "przed lagrangian" call lagrangian -write(iout,*) "po lagrangian" if(.not.out1file .and. large) then write (iout,*) "energia_long",energia_long(0),& " energia_short",energia_short(0),& @@ -2539,9 +2547,7 @@ write(iout,*) "po lagrangian" #endif #endif call cartgrad -write(iout,*) "przed lagrangian2" call lagrangian -write(iout,*) "po lagrangian2" if(.not.out1file .and. large) then write (iout,*) "energia_long",energia_long(0) write (iout,*) "Initial slow-force accelerations" @@ -2556,7 +2562,6 @@ write(iout,*) "po lagrangian2" t_enegrad=t_enegrad+tcpu()-tt0 #endif endif -write(iout,*) "end init MD" return end subroutine init_MD !----------------------------------------------------------------------------- @@ -4562,6 +4567,7 @@ write(iout,*) "end init MD" !----------------------------------------------------------------------------- subroutine setup_fricmat +! use MPI use energy_data use control_data, only:time_Bcast use control, only:tcpu @@ -4774,12 +4780,10 @@ write(iout,*) "end init MD" #else time00=tcpu() #endif -write(iout,*)"przed MPI_Scatterv in fricmat" ! 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) -write(iout,*)"po MPI_Scatterv in fricmat" #ifdef TIMING #ifdef MPI time_scatter=time_scatter+MPI_Wtime()-time00 @@ -4789,13 +4793,11 @@ write(iout,*)"po MPI_Scatterv in fricmat" time_scatter_fmat=time_scatter_fmat+tcpu()-time00 #endif #endif -write(iout,*)"po MPI_Scatterv in fricmat" do i=1,dimen do j=1,2*my_ng_count fricmat(j,i)=fcopy(i,j) enddo enddo -write(iout,*)"po MPI_Scatterv in fricmat" ! write (iout,*) "My chunk of fricmat" ! call MATOUT2(my_ng_count,dimen,maxres2,maxres2,fcopy) endif @@ -5645,6 +5647,14 @@ write(iout,*)"po MPI_Scatterv in fricmat" if(.not.allocated(nginv_start)) allocate(nginv_start(0:nfgtasks)) !(0:MaxProcs) !---------------------- ! common.muca in read_muca +! common /double_muca/ +! real(kind=8) :: elow,ehigh,factor,hbin,factor_min +! real(kind=8),dimension(:),allocatable :: emuca,nemuca,& +! nemuca2,hist !(4*maxres) +! common /integer_muca/ +! integer :: nmuca,imtime,muca_smooth +! common /mucarem/ +! real(kind=8),dimension(:),allocatable :: elowi,ehighi !(maxprocs) !---------------------- ! common.MD ! common /mdgrad/ in module.energy diff --git a/source/unres/MD_data.f90 b/source/unres/MD_data.f90 deleted file mode 100644 index 1332327..0000000 --- a/source/unres/MD_data.f90 +++ /dev/null @@ -1,100 +0,0 @@ - module MD_data -!----------------------------------------------------------------------------- -#ifndef LANG0 -! commom.langevin -! common /langforc/ - real(kind=8),dimension(:,:),allocatable :: friction,stochforc !(3,0:MAXRES2) - real(kind=8),dimension(:),allocatable :: fric_work,stoch_work,& - fricgam !(MAXRES6) - real(kind=8),dimension(:,:),allocatable :: fricmat,fricvec,& - pfric_mat,vfric_mat,afric_mat,prand_mat,vrand_mat1,& - vrand_mat2 !(MAXRES2,MAXRES2) - real(kind=8),dimension(:,:,:),allocatable :: pfric0_mat,& - afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1,vrand0_mat2 !(MAXRES2,MAXRES2,0:maxflag_stoch) - logical,dimension(:),allocatable :: flag_stoch !(0:maxflag_stoch) -! common /langmat/ - real(kind=8),dimension(:,:),allocatable :: mt1,mt2,mt3 !(maxres2,maxres2) -!----------------------------------------------------------------------------- -#else -! commom.langevin.lang0 -! common /langforc/ - real(kind=8),dimension(:,:),allocatable :: friction,stochforc !(3,0:MAXRES2) - real(kind=8),dimension(:,:),allocatable :: fricmat,fricvec !(MAXRES2,MAXRES2) - real(kind=8),dimension(:),allocatable :: fric_work,stoch_work,& - fricgam !(MAXRES6) - logical,dimension(:),allocatable :: flag_stoch !(0:maxflag_stoch) - real(kind=8) :: vrand_mat1,vrand_mat2,prand_mat,vfric_mat,afric_mat,& - pfric_mat,pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1,& - vrand0_mat2 -! common /langmat/ - integer :: mt1,mt2,mt3 -#endif -!----------------------------------------------------------------------------- -! commom.hairpin in CSA module -!----------------------------------------------------------------------------- -! common.mce in MCM_MD module -!----------------------------------------------------------------------------- -! common.MD -! common /mdgrad/ in module.energy -! common /back_constr/ in module.energy -! common /qmeas/ in module.energy -! common /mdpar/ - real(kind=8) :: v_ini,d_time,d_time0,scal_fric,& - t_bath,tau_bath,dvmax,damax - integer :: n_timestep,ntime_split,ntime_split0,maxtime_split,& - ntwx,ntwe - logical :: mdpdb,large,print_compon,tbf,rest -! common /MDcalc/ - real(kind=8) :: totT,totE,potE,EK,amax,edriftmax,kinetic_T - real(kind=8),dimension(:),allocatable :: potEcomp !(0:n_ene+4) -! common /lagrange/ - real(kind=8),dimension(:,:),allocatable :: d_t,d_a,d_t_old !(3,0:MAXRES2) - real(kind=8),dimension(:),allocatable :: d_a_work !(6*MAXRES) - real(kind=8),dimension(:,:),allocatable :: Gmat,Ginv,A,& - Gsqrp,Gsqrm,Gvec !(maxres2,maxres2) - real(kind=8),dimension(:),allocatable :: Geigen !(maxres2) - real(kind=8),dimension(:),allocatable ::vtot !(maxres2) - logical :: reset_moment,reset_vel,rattle,RESPA - integer :: dimen,dimen1,dimen3 - integer :: lang,count_reset_moment,count_reset_vel -! common /inertia/ - real(kind=8) :: IP,mp - real(kind=8),dimension(:),allocatable :: ISC,msc !(ntyp+1) -! common /langevin/ - real(kind=8) :: rwat,etawat,stdfp,pstok,gamp!,Rb - real(kind=8) :: cPoise=2.9361d0, Rb=0.001986d0 - real(kind=8),dimension(:),allocatable :: gamsc !(ntyp1) - real(kind=8),dimension(:),allocatable :: stdfsc !(ntyp) - - real(kind=8),dimension(:),allocatable :: restok !(ntyp+1) - logical :: surfarea - integer :: reset_fricmat -! common /mdpmpi/ - integer :: igmult_start,igmult_end,my_ng_count,myginv_ng_count - integer,dimension(:),allocatable :: ng_start,ng_counts,& - nginv_counts !(0:MaxProcs-1) - integer,dimension(:),allocatable :: nginv_start !(0:MaxProcs) -!----------------------------------------------------------------------------- -! common.muca -! common /double_muca/ - real(kind=8) :: elow,ehigh,factor,hbin,factor_min - real(kind=8),dimension(:),allocatable :: emuca,nemuca,& - nemuca2,hist !(4*maxres) -! common /integer_muca/ - integer :: nmuca,imtime,muca_smooth -! common /mucarem/ - real(kind=8),dimension(:),allocatable :: elowi,ehighi !(maxprocs) -!----------------------------------------------------------------------------- -! Maximum number of timesteps for which stochastic MD matrices can be stored - integer,parameter :: maxflag_stoch=0 -!----------------------------------------------------------------------------- -! common /przechowalnia/ subroutines: setup_MD_matrices - real(kind=8),dimension(:,:),allocatable :: Gcopy !(maxres2,maxres2), maxres2=2*maxres -!----------------------------------------------------------------------------- -! common /przechowalnia/ subroutines: setup_fricmat,setup_MD_matrices - real(kind=8),dimension(:),allocatable :: Ghalf -!----------------------------------------------------------------------------- -! COMMON /BANII/ D - real(kind=8),DIMENSION(:),allocatable :: D_ban !(MAXRES6) maxres6=6*maxres -!----------------------------------------------------------------------------- - end module MD_data diff --git a/source/unres/MPI_data.f90 b/source/unres/MPI_data.f90 deleted file mode 100644 index c034fda..0000000 --- a/source/unres/MPI_data.f90 +++ /dev/null @@ -1,54 +0,0 @@ - module MPI_data - -!----------------------------------------------------------------------------- - integer,parameter :: max_cg_procs=2048 -!----------------------------------------------------------------------------- -! commom.info -! NPROCS - total number of processors; -! MyID - processor's ID; -! MasterID - master processor's ID. - integer :: tag - integer,dimension(:),allocatable :: status !(MPI_STATUS_SIZE) -! common /info/ - integer :: myid,masterid,allgrp,dontcare,WhatsUp - logical,dimension(:),allocatable :: koniec !(0:maxprocs-1) -!el integer,dimension(:),allocatable :: ifinish !(maxprocs-1) -!... 5/12/96 - added variables for collective communication -! FGPROCS - Number of fine-grain processors per coarse-grain task; -! NCTASKS - Number of coarse-grain tasks; -! MYGROUP - label of the processor's FG group id; -! BOSSID - ID of group's master; -! FGLIST - list of group's FG processors. -! MSGLEN_VAR - length of the vector of variables passed to the fine-grain -! slave processors -! common /info1/ - integer :: fgprocs,nctasks,mygroup,bossid,cglabel,& - cgGroupID,fgGroupID,msglen_var - integer,dimension(:),allocatable :: cglist,fglist !(max_fg_procs) !not used ??? -!----------------------------------------------------------------------------- -! common.setup - integer,parameter :: king=0,idint=1105 - integer,parameter :: idreal=1729,idchar=1597,is_done=1 -! common/setup/ - integer :: me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,& - kolor,nfgtasks1,MyRank,kolor1,key1,max_gs_size,& - CG_COMM,FG_COMM,FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM -!el integer,dimension(:),allocatable :: koniec !(0:maxprocs-1) - integer,dimension(:),allocatable :: lentyp !(0:maxprocs-1) - integer,dimension(:),allocatable :: ifinish !(maxprocs-1) - logical :: yourjob,finished,cgdone -! common /types/ - integer :: MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,& - MPI_THET,MPI_GAM - integer,dimension(0:1) :: MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,& - MPI_PRECOMP11,MPI_PRECOMP12,MPI_PRECOMP22,MPI_PRECOMP23 -!----------------------------------------------------------------------------- -#ifdef WHAM_RUN -! COMMON.MPI -! common /MPI_Data/ - integer :: Master,Master1,Comm1,Me1,Nprocs1,WHAM_COMM - integer,dimension(:),allocatable :: Indstart,Indend,idispl,& - scount !(0:MaxProcs) -#endif -!----------------------------------------------------------------------------- - end module MPI_data diff --git a/source/unres/MREMD.f90 b/source/unres/MREMD.f90 index f33432f..92a1178 100644 --- a/source/unres/MREMD.f90 +++ b/source/unres/MREMD.f90 @@ -18,16 +18,16 @@ integer(kind=2),dimension(:),allocatable :: ifirst !(maxprocs) integer(kind=2),dimension(:,:),allocatable :: nupa,& ndowna !(0:maxprocs/4,0:maxprocs) - real(kind=8),dimension(:,:),allocatable :: t_restart1 !(5,maxprocs) + real(kind=4),dimension(:,:),allocatable :: t_restart1 !(5,maxprocs) integer,dimension(:),allocatable :: iset_restart1 !(maxprocs) ! common /traj1cache/ - real(kind=8),dimension(:),allocatable :: totT_cache,EK_cache,& + real(kind=4),dimension(:),allocatable :: totT_cache,EK_cache,& potE_cache,t_bath_cache,Uconst_cache !(max_cache_traj) - real(kind=8),dimension(:,:),allocatable :: qfrag_cache !(50,max_cache_traj) - real(kind=8),dimension(:,:),allocatable :: qpair_cache !(100,max_cache_traj) - real(kind=8),dimension(:,:),allocatable :: ugamma_cache,& + real(kind=4),dimension(:,:),allocatable :: qfrag_cache !(50,max_cache_traj) + real(kind=4),dimension(:,:),allocatable :: qpair_cache !(100,max_cache_traj) + real(kind=4),dimension(:,:),allocatable :: ugamma_cache,& utheta_cache,uscdiff_cache !(maxfrag_back,max_cache_traj) - real(kind=8),dimension(:,:,:),allocatable :: c_cache !(3,maxres2+2,max_cache_traj) + real(kind=4),dimension(:,:,:),allocatable :: c_cache !(3,maxres2+2,max_cache_traj) integer :: ntwx_cache,ii_write !,max_cache_traj_use integer,dimension(:),allocatable :: iset_cache !(max_cache_traj) !----------------------------------------------------------------------------- @@ -112,7 +112,6 @@ nres2=2*nres time001=0.0d0 -write(iout,*) "jestesmy na poczatku MREMD" ntwx_cache=0 time00=MPI_WTIME() time01=time00 @@ -121,7 +120,6 @@ write(iout,*) "jestesmy na poczatku MREMD" write (iout,*) "NREP=",nrep endif -write(iout,*) "jestesmy na poczatku MREMD" synflag=.false. if (ilen(tmpdir).gt.0 .and. (me.eq.king)) then call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_mremd.rst") @@ -831,6 +829,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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 !o write(iout,*) 'REMD exchange temp,ene,elow,ehigh' do i=1,nodes @@ -844,6 +843,7 @@ write(iout,*) "jestesmy na poczatku MREMD" write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene) enddo endif +#endif !------------------------------------- IF(.not.usampl) THEN write (iout,*) "Enter exchnge, remd_m",remd_m(1),& @@ -857,7 +857,9 @@ write(iout,*) "jestesmy na poczatku MREMD" 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 ! if (i.eq.1 .and. int(nupa(0,i)).eq.1) then @@ -1216,6 +1218,12 @@ write(iout,*) "jestesmy na poczatku MREMD" time06=MPI_WTIME() !d write (iout,*) "Before scatter" !d call flush(iout) +#ifdef DEBUG + if (me.eq.king) then + write (iout,*) "t_bath before scatter",remd_t_bath + call flush(iout) + endif +#endif call mpi_scatter(remd_t_bath,1,mpi_double_precision,& t_bath,1,mpi_double_precision,king,& CG_COMM,ierr) @@ -1251,7 +1259,15 @@ write(iout,*) "jestesmy na poczatku MREMD" !de 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 + write(iout,*) 'REMD exchange time 8-0=',time08-time00 + write(iout,*) 'REMD exchange time 8-7=',time08-time07 + write(iout,*) 'REMD exchange time 7-6=',time07-time06 + write(iout,*) 'REMD exchange time 6-5=',time06-time05 + write(iout,*) 'REMD exchange time 5-4=',time05-time04 + write(iout,*) 'REMD exchange time 4-3=',time04-time03 + write(iout,*) 'REMD exchange time 3-2=',time03-time02 + write(iout,*) 'REMD exchange time 2-1=',time02-time01 + write(iout,*) 'REMD exchange time 1-0=',time01-time00 call flush(iout) endif endif @@ -1291,9 +1307,9 @@ write(iout,*) "jestesmy na poczatku MREMD" ' End of MD calculation ' endif !el common /przechowalnia/ - deallocate(d_restart1) - deallocate(d_restart2) - deallocate(p_c) +! deallocate(d_restart1) +! deallocate(d_restart2) +! deallocate(p_c) !el-------------- return end subroutine MREMD @@ -1517,13 +1533,22 @@ write(iout,*) "jestesmy na poczatku MREMD" if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret) #endif do ii=1,ii_write +! write (iout,*) "before gather write1traj: from node",ii +! call flush(iout) +! write (iout,*) totT_cache(ii),EK_cache(ii),potE_cache(ii),t_bath_cache(ii),Uconst_cache(ii) +! call flush(iout) 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) +! write (iout,*) "before gather write1traj: from node",ii,t5_restart1(1),t5_restart1(3),t5_restart1(5),t5_restart1(4) + call flush(iout) call mpi_gather(t5_restart1,5,mpi_real,& t_restart1,5,mpi_real,king,CG_COMM,ierr) +! do il=1,nodes +! write (iout,*) "after gather write1traj: from node",il,t_restart1(1,il),t_restart1(3,il),t_restart1(5,il),t_restart1(4,il) +! enddo call mpi_gather(iset_cache(ii),1,mpi_integer,& iset_restart1,1,mpi_integer,king,CG_COMM,ierr) @@ -1627,6 +1652,7 @@ write(iout,*) "jestesmy na poczatku MREMD" 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) +! write (iout,*) "write1traj: from node",ii,t_restart1(1,il),t_restart1(3,il),t_restart1(5,il),t_restart1(4,il) call xdrfint(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then diff --git a/source/unres/Makefile b/source/unres/Makefile index d0df6e4..db1bc7b 100644 --- a/source/unres/Makefile +++ b/source/unres/Makefile @@ -1,22 +1,35 @@ ################################################################### -# -# 2015 writed by Emilia Lubecka -# +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users2/emilial/UNRES/new_F90/source/unres_MD-M FC= ${INSTALL_DIR}/bin/mpif90 OPT = -O3 -ip -FFLAGS = -fpp -c ${OPT} -FFLAGSm = -fpp -c -O -FFLAGS1 = -fpp -c -g -CA -CB -FFLAGS2 = -fpp -c -g -O0 -FFLAGSE = -fpp -c ${OPT} +#FFLAGS = -fpp -c ${OPT} -I$(INSTALL_DIR)/include +#-mcmodel large -check arg_temp_created -heap-arrays -recursive +FFLAGS = -fpp -c ${OPT} #-auto +#FFLAGS = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer +#FFLAGSm = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +#FFLAGS_ = -fpp -c -g -CA -CB -zero -traceback -u -check pointer -check uninit +FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -traceback -u -check pointer -check uninit +#FFLAGS1 = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer -O3 -ipo -opt_report #-g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-I$(INSTALL_DIR)/include +#FFLAGSE = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-O3 -ipo -opt_report + +#CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +# -lmpl only necessary for mpich2-1.4.1p1_intel +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -lmpl ARCH = LINUX PP = /lib/cpp -P +#EXE_FILE = unres_MD-M_E0LL2Y_F90_EL.exe + all: no_option @echo "Specify force field: GAB, 4P or E0LL2Y; or NOMPI" @@ -25,96 +38,120 @@ all: no_option .f90.o: ${FC} ${FFLAGS} ${CPPFLAGS} $*.f90 -objects = ../xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o \ +DATA_FILE= ./data + +data = names.o io_units.o calc_data.o compare_data.o control_data.o \ CSA_data.o energy_data.o geometry_data.o map_data.o \ - MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o \ + MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o + +objects = xdrf/*.o \ prng_32.o math.o random.o geometry.o md_calc.o io_base.o energy.o check_bond.o muca_md.o\ control.o io_config.o MPI.o minim.o \ regularize.o compare.o map.o REMD.o MCM_MD.o io.o \ MD.o MREMD.o CSA.o unres.o +#${EXE_FILE}: ${objects} +# ${FC} ${OPT} ${objects} -o ${EXE_FILE} + no_option: +#NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +NOMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 +#NOMPI: EXE_FILE = ../../bin/unres_MD-M_NO_MPI_F90_EL.exe +NOMPI: EXE_FILE = ../../bin/unres_NO_MPI_F90_EL.exe + +NOMPI: ${data} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${data} ${objects} cinfo.o -o ${EXE_FILE} + +# ${FC} ${objects} -Xlinker -M -o ${EXE_FILE} GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +#GAB: EXE_FILE = ../../bin/unres_MD-M_GAB_F90_EL_opt3.exe GAB: EXE_FILE = ../../bin/unres_GAB_F90_EL.exe -GAB: ${objects} +GAB: ${data} ${objects} cc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f90 - ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + ${FC} ${OPT} ${data} ${objects} cinfo.o -o ${EXE_FILE} 4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +#4P: EXE_FILE = ../../bin/unres_MD-M_4P_F90_EL_opt3.exe 4P: EXE_FILE = ../../bin/unres_4P_F90_EL.exe -4P: ${objects} +4P: ${data}${objects} cc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f90 - ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + ${FC} ${OPT} ${data} ${objects} cinfo.o -o ${EXE_FILE} E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ -DSPLITELE -DLANG0 +#E0LL2Y: EXE_FILE = ../../bin/unres_MD-M_E0LL2Y_F90_EL_opt3.exe E0LL2Y: EXE_FILE = ../../bin/unres_E0LL2Y_F90_EL.exe -E0LL2Y: ${objects} +E0LL2Y: ${data} ${objects} cc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f90 - ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + ${FC} ${OPT} ${data} ${objects} cinfo.o -o ${EXE_FILE} -../xdrf/*.o: - cd ../xdrf && make +xdrf/*.o: + cd xdrf && make clean: - rm -f *.o && rm -f *.mod && rm -f compinfo && cd ../xdrf && make clean + rm -f *.o && rm -f *.mod && rm -f compinfo && cd xdrf && make clean +# rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean -names.o: names.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} names.f90 +names.o: ${DATA_FILE}/names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/names.f90 -io_units.o: io_units.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} io_units.f90 +io_units.o: ${DATA_FILE}/io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/io_units.f90 -calc_data.o: calc_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} calc_data.f90 +calc_data.o: ${DATA_FILE}/calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/calc_data.f90 -compare_data.o: compare_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} compare_data.f90 +compare_data.o: ${DATA_FILE}/compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/compare_data.f90 -control_data.o: control_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} control_data.f90 +control_data.o: ${DATA_FILE}/control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/control_data.f90 -CSA_data.o: CSA_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} CSA_data.f90 +CSA_data.o: ${DATA_FILE}/CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/CSA_data.f90 -energy_data.o: energy_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} energy_data.f90 +energy_data.o: ${DATA_FILE}/energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/energy_data.f90 -geometry_data.o: geometry_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} geometry_data.f90 +geometry_data.o: ${DATA_FILE}/geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/geometry_data.f90 -map_data.o: map_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} map_data.f90 +map_data.o: ${DATA_FILE}/map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/map_data.f90 -MCM_data.o: MCM_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} MCM_data.f90 +MCM_data.o: ${DATA_FILE}/MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/MCM_data.f90 -MD_data.o: MD_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} MD_data.f90 +MD_data.o: ${DATA_FILE}/MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/MD_data.f90 -minim_data.o: minim_data.f90 - ${FC} ${FFLAGSm} ${CPPFLAGS} minim_data.f90 +minim_data.o: ${DATA_FILE}/minim_data.f90 + ${FC} ${FFLAGSm} ${CPPFLAGS} ${DATA_FILE}/minim_data.f90 -MPI_data.o: MPI_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} MPI_data.f90 +MPI_data.o: ${DATA_FILE}/MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/MPI_data.f90 -REMD_data.o: REMD_data.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} REMD_data.f90 +REMD_data.o: ${DATA_FILE}/REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/REMD_data.f90 -comm_local.o: comm_local.f90 - ${FC} ${FFLAGS} ${CPPFLAGS} comm_local.f90 +comm_local.o: ${DATA_FILE}/comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${DATA_FILE}/comm_local.f90 prng_32.o: prng_32.f90 ${FC} ${FFLAGS} ${CPPFLAGS} prng_32.f90 diff --git a/source/unres/Makefile_MPICH_ifort_flags b/source/unres/Makefile_MPICH_ifort_flags new file mode 100644 index 0000000..f8741f9 --- /dev/null +++ b/source/unres/Makefile_MPICH_ifort_flags @@ -0,0 +1,214 @@ +################################################################### +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users2/emilial/UNRES/new_F90/source/unres_MD-M + +FC= ${INSTALL_DIR}/bin/mpif90 + +OPT = -O3 -ip + +#FFLAGS = -fpp -c ${OPT} -I$(INSTALL_DIR)/include +#-mcmodel large -check arg_temp_created -heap-arrays -recursive +#FFLAGS = -fpp -c ${OPT} #-auto +FFLAGS = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +#FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer +FFLAGSm = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +#FFLAGS_ = -fpp -c -g -CA -CB -zero -traceback -u -check pointer -check uninit +#FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -traceback -u -check pointer -check uninit +FFLAGS1 = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer -O3 -ipo -opt_report #-g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-O3 -ipo -opt_report + +#CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +# -lmpl only necessary for mpich2-1.4.1p1_intel +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -lmpl + +ARCH = LINUX +PP = /lib/cpp -P + +#EXE_FILE = unres_MD-M_E0LL2Y_F90_EL.exe + + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y; or NMPI" + +.SUFFIXES: .f90 +.f90.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.f90 + +objects = xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o \ + CSA_data.o energy_data.o geometry_data.o map_data.o \ + MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o \ + prng_32.o math.o random.o geometry.o md_calc.o io_base.o energy.o check_bond.o muca_md.o\ + control.o io_config.o MPI.o minim.o \ + regularize.o compare.o map.o REMD.o MCM_MD.o io.o \ + MD.o MREMD.o CSA.o unres.o + + +#${EXE_FILE}: ${objects} +# ${FC} ${OPT} ${objects} -o ${EXE_FILE} + +no_option: + +#NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 +NMPI: EXE_FILE = ../../bin/unres_MD-M_NO_MPI_F90_EL.exe + +NMPI: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +# ${FC} ${objects} -Xlinker -M -o ${EXE_FILE} +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: EXE_FILE = ../../bin/unres_MD-M_GAB_F90_EL_flags.exe +GAB: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: EXE_FILE = ../../bin/unres_MD-M_4P_F90_EL_flags.exe +4P: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 +E0LL2Y: EXE_FILE = ../../bin/unres_MD-M_E0LL2Y_F90_EL_flags.exe +E0LL2Y: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +names.o: names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} names.f90 + +io_units.o: io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_units.f90 + +calc_data.o: calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} calc_data.f90 + +compare_data.o: compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare_data.f90 + +control_data.o: control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control_data.f90 + +CSA_data.o: CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA_data.f90 + +energy_data.o: energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} energy_data.f90 + +geometry_data.o: geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry_data.f90 + +map_data.o: map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map_data.f90 + +MCM_data.o: MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_data.f90 + +MD_data.o: MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MD_data.f90 + +minim_data.o: minim_data.f90 + ${FC} ${FFLAGSm} ${CPPFLAGS} minim_data.f90 + +MPI_data.o: MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI_data.f90 + +REMD_data.o: REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} REMD_data.f90 + +comm_local.o: comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} comm_local.f90 + +prng_32.o: prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} prng_32.f90 + +math.o: math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} math.f90 + +random.o: random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} random.f90 + +geometry.o: geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry.f90 + +md_calc.o: md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} md_calc.f90 + +io_base.o: io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_base.f90 + +energy.o: energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} energy.f90 + +check_bond.o: check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} check_bond.f90 + +control.o: control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control.f90 + +io_config.o: io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} io_config.f90 + +MPI.o: MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI.f90 + +minim.o: minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} minim.f90 + +regularize.o: regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} regularize.f90 + +compare.o: compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare.f90 + +map.o: map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map.f90 + +muca_md.o: muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} muca_md.f90 + +REMD.o: REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} REMD.f90 + +MCM_MD.o: MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_MD.f90 + +io.o: io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io.f90 + +MD.o: MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} MD.f90 + +MREMD.o: MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MREMD.f90 + +CSA.o: CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA.f90 + +unres.o: unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} unres.f90 diff --git a/source/unres/Makefile_MPICH_ifort_gCACB b/source/unres/Makefile_MPICH_ifort_gCACB new file mode 100644 index 0000000..e1259be --- /dev/null +++ b/source/unres/Makefile_MPICH_ifort_gCACB @@ -0,0 +1,214 @@ +################################################################### +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users2/emilial/UNRES/new.f90/source/unres_MD-M + +FC= ${INSTALL_DIR}/bin/mpif90 + +OPT = -O3 -ip + +#FFLAGS = -fpp -c ${OPT} -I$(INSTALL_DIR)/include +#-mcmodel large -check arg_temp_created -heap-arrays -recursive +#FFLAGS = -fpp -c ${OPT} #-auto +FFLAGS = -fpp -c -g -CA -CB #-auto -zero -traceback -u -check pointer -check uninit +#FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer +FFLAGSm = -fpp -c -g -CA -CB #-auto -zero -traceback -u -check pointer -check uninit +#FFLAGS_ = -fpp -c -g -CA -CB -zero -traceback -u -check pointer -check uninit +#FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -traceback -u -check pointer -check uninit +FFLAGS1 = -fpp -c -g -CA -CB #-auto -zero -traceback -u -check pointer -check uninit +FFLAGS2 = -fpp -c -g -CA -CB #-O0 #-I$(INSTALL_DIR)/include +#FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer -O3 -ipo -opt_report #-g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c -g -CA -CB #-auto -zero -traceback -u -check pointer -check uninit #-O3 -ipo -opt_report + +#CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +# -lmpl only necessary for mpich2-1.4.1p1_intel +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -lmpl + +ARCH = LINUX +PP = /lib/cpp -P + +#EXE_FILE = unres_MD-M_E0LL2Y.f90_EL.exe + + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y; or NMPI" + +.SUFFIXES: .f90 +.f90.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.f90 + +objects = xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o \ + CSA_data.o energy_data.o geometry_data.o map_data.o \ + MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o \ + prng_32.o math.o random.o geometry.o md_calc.o io_base.o energy.o check_bond.o muca_md.o\ + control.o io_config.o MPI.o minim.o \ + regularize.o compare.o map.o REMD.o MCM_MD.o io.o \ + MD.o MREMD.o CSA.o unres.o + + +#${EXE_FILE}: ${objects} +# ${FC} ${OPT} ${objects} -o ${EXE_FILE} + +no_option: + +#NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 +NMPI: EXE_FILE = ../../bin/unres_NO_MPI.F90_EL.exe + +NMPI: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${objects} cinfo.o -o ${EXE_FILE} + +# ${FC} ${objects} -Xlinker -M -o ${EXE_FILE} +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: EXE_FILE = ../../bin/unres_GAB_F90_EL_gCACB.exe +GAB: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: EXE_FILE = ../../bin/unres_4P_F90_EL_gCACB.exe +4P: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 +E0LL2Y: EXE_FILE = ../../bin/unres_E0LL2Y_F90_EL_gCACB.exe +E0LL2Y: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +names.o: names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} names.f90 + +io_units.o: io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_units.f90 + +calc_data.o: calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} calc_data.f90 + +compare_data.o: compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare_data.f90 + +control_data.o: control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control_data.f90 + +CSA_data.o: CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA_data.f90 + +energy_data.o: energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} energy_data.f90 + +geometry_data.o: geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry_data.f90 + +map_data.o: map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map_data.f90 + +MCM_data.o: MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_data.f90 + +MD_data.o: MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MD_data.f90 + +minim_data.o: minim_data.f90 + ${FC} ${FFLAGSm} ${CPPFLAGS} minim_data.f90 + +MPI_data.o: MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI_data.f90 + +REMD_data.o: REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} REMD_data.f90 + +comm_local.o: comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} comm_local.f90 + +prng_32.o: prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} prng_32.f90 + +math.o: math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} math.f90 + +random.o: random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} random.f90 + +geometry.o: geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry.f90 + +md_calc.o: md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} md_calc.f90 + +io_base.o: io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_base.f90 + +energy.o: energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} energy.f90 + +check_bond.o: check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} check_bond.f90 + +control.o: control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control.f90 + +io_config.o: io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} io_config.f90 + +MPI.o: MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI.f90 + +minim.o: minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} minim.f90 + +regularize.o: regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} regularize.f90 + +compare.o: compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare.f90 + +map.o: map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map.f90 + +muca_md.o: muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} muca_md.f90 + +REMD.o: REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} REMD.f90 + +MCM_MD.o: MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_MD.f90 + +io.o: io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io.f90 + +MD.o: MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} MD.f90 + +MREMD.o: MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MREMD.f90 + +CSA.o: CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA.f90 + +unres.o: unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} unres.f90 diff --git a/source/unres/Makefile_MPICH_ifort_opt3 b/source/unres/Makefile_MPICH_ifort_opt3 new file mode 100644 index 0000000..a5d394f --- /dev/null +++ b/source/unres/Makefile_MPICH_ifort_opt3 @@ -0,0 +1,214 @@ +################################################################### +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users2/emilial/UNRES/new_F90/source/unres_MD-M + +FC= ${INSTALL_DIR}/bin/mpif90 + +OPT = -O3 -ip + +#FFLAGS = -fpp -c ${OPT} -I$(INSTALL_DIR)/include +#-mcmodel large -check arg_temp_created -heap-arrays -recursive +FFLAGS = -fpp -c ${OPT} #-auto +#FFLAGS = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer +#FFLAGSm = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +#FFLAGS_ = -fpp -c -g -CA -CB -zero -traceback -u -check pointer -check uninit +FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -traceback -u -check pointer -check uninit +#FFLAGS1 = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer -O3 -ipo -opt_report #-g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-I$(INSTALL_DIR)/include +#FFLAGSE = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-O3 -ipo -opt_report + +#CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +# -lmpl only necessary for mpich2-1.4.1p1_intel +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -lmpl + +ARCH = LINUX +PP = /lib/cpp -P + +#EXE_FILE = unres_MD-M_E0LL2Y_F90_EL.exe + + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y; or NMPI" + +.SUFFIXES: .f90 +.f90.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.f90 + +objects = xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o \ + CSA_data.o energy_data.o geometry_data.o map_data.o \ + MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o \ + prng_32.o math.o random.o geometry.o md_calc.o io_base.o energy.o check_bond.o muca_md.o\ + control.o io_config.o MPI.o minim.o \ + regularize.o compare.o map.o REMD.o MCM_MD.o io.o \ + MD.o MREMD.o CSA.o unres.o + + +#${EXE_FILE}: ${objects} +# ${FC} ${OPT} ${objects} -o ${EXE_FILE} + +no_option: + +#NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 +NMPI: EXE_FILE = ../../bin/unres_MD-M_NO_MPI_F90_EL.exe + +NMPI: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${objects} cinfo.o -o ${EXE_FILE} + +# ${FC} ${objects} -Xlinker -M -o ${EXE_FILE} +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: EXE_FILE = ../../bin/unres_MD-M_GAB_F90_EL_opt3.exe +GAB: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: EXE_FILE = ../../bin/unres_MD-M_4P_F90_EL_opt3.exe +4P: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 +E0LL2Y: EXE_FILE = ../../bin/unres_MD-M_E0LL2Y_F90_EL_opt3.exe +E0LL2Y: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +names.o: names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} names.f90 + +io_units.o: io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_units.f90 + +calc_data.o: calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} calc_data.f90 + +compare_data.o: compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare_data.f90 + +control_data.o: control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control_data.f90 + +CSA_data.o: CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA_data.f90 + +energy_data.o: energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} energy_data.f90 + +geometry_data.o: geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry_data.f90 + +map_data.o: map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map_data.f90 + +MCM_data.o: MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_data.f90 + +MD_data.o: MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MD_data.f90 + +minim_data.o: minim_data.f90 + ${FC} ${FFLAGSm} ${CPPFLAGS} minim_data.f90 + +MPI_data.o: MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI_data.f90 + +REMD_data.o: REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} REMD_data.f90 + +comm_local.o: comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} comm_local.f90 + +prng_32.o: prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} prng_32.f90 + +math.o: math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} math.f90 + +random.o: random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} random.f90 + +geometry.o: geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry.f90 + +md_calc.o: md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} md_calc.f90 + +io_base.o: io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_base.f90 + +energy.o: energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} energy.f90 + +check_bond.o: check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} check_bond.f90 + +control.o: control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control.f90 + +io_config.o: io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} io_config.f90 + +MPI.o: MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI.f90 + +minim.o: minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} minim.f90 + +regularize.o: regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} regularize.f90 + +compare.o: compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare.f90 + +map.o: map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map.f90 + +muca_md.o: muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} muca_md.f90 + +REMD.o: REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} REMD.f90 + +MCM_MD.o: MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_MD.f90 + +io.o: io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io.f90 + +MD.o: MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} MD.f90 + +MREMD.o: MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MREMD.f90 + +CSA.o: CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA.f90 + +unres.o: unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} unres.f90 diff --git a/source/unres/Makefile_final b/source/unres/Makefile_final new file mode 100644 index 0000000..f024682 --- /dev/null +++ b/source/unres/Makefile_final @@ -0,0 +1,218 @@ +################################################################### +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users2/emilial/UNRES/new_F90/source/unres_MD-M + +FC= ${INSTALL_DIR}/bin/mpif90 + +OPT = -O3 -ip + +#FFLAGS = -fpp -c ${OPT} -I$(INSTALL_DIR)/include +#-mcmodel large -check arg_temp_created -heap-arrays -recursive +FFLAGS = -fpp -c ${OPT} #-auto +#FFLAGS = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer +#FFLAGSm = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +#FFLAGS_ = -fpp -c -g -CA -CB -zero -traceback -u -check pointer -check uninit +FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -traceback -u -check pointer -check uninit +#FFLAGS1 = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer -O3 -ipo -opt_report #-g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-I$(INSTALL_DIR)/include +#FFLAGSE = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-O3 -ipo -opt_report + +#CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +# -lmpl only necessary for mpich2-1.4.1p1_intel +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -lmpl + +ARCH = LINUX +PP = /lib/cpp -P + +#EXE_FILE = unres_MD-M_E0LL2Y_F90_EL.exe + + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y; or NOMPI" + +.SUFFIXES: .f90 +.f90.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.f90 + +objects = xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o \ + CSA_data.o energy_data.o geometry_data.o map_data.o \ + MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o \ + prng_32.o math.o random.o geometry.o md_calc.o io_base.o energy.o check_bond.o muca_md.o\ + control.o io_config.o MPI.o minim.o \ + regularize.o compare.o map.o REMD.o MCM_MD.o io.o \ + MD.o MREMD.o CSA.o unres.o + + +#${EXE_FILE}: ${objects} +# ${FC} ${OPT} ${objects} -o ${EXE_FILE} + +no_option: + +#NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +NOMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 +#NOMPI: EXE_FILE = ../../bin/unres_MD-M_NO_MPI_F90_EL.exe +NOMPI: EXE_FILE = ../../bin/unres_NO_MPI_F90_EL.exe + +NOMPI: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${objects} cinfo.o -o ${EXE_FILE} + +# ${FC} ${objects} -Xlinker -M -o ${EXE_FILE} +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +#GAB: EXE_FILE = ../../bin/unres_MD-M_GAB_F90_EL_opt3.exe +GAB: EXE_FILE = ../../bin/unres_GAB_F90_EL.exe +GAB: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +#4P: EXE_FILE = ../../bin/unres_MD-M_4P_F90_EL_opt3.exe +4P: EXE_FILE = ../../bin/unres_4P_F90_EL.exe +4P: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 +#E0LL2Y: EXE_FILE = ../../bin/unres_MD-M_E0LL2Y_F90_EL_opt3.exe +E0LL2Y: EXE_FILE = ../../bin/unres_E0LL2Y_F90_EL.exe +E0LL2Y: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +names.o: names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} names.f90 + +io_units.o: io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_units.f90 + +calc_data.o: calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} calc_data.f90 + +compare_data.o: compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare_data.f90 + +control_data.o: control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control_data.f90 + +CSA_data.o: CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA_data.f90 + +energy_data.o: energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} energy_data.f90 + +geometry_data.o: geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry_data.f90 + +map_data.o: map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map_data.f90 + +MCM_data.o: MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_data.f90 + +MD_data.o: MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MD_data.f90 + +minim_data.o: minim_data.f90 + ${FC} ${FFLAGSm} ${CPPFLAGS} minim_data.f90 + +MPI_data.o: MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI_data.f90 + +REMD_data.o: REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} REMD_data.f90 + +comm_local.o: comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} comm_local.f90 + +prng_32.o: prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} prng_32.f90 + +math.o: math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} math.f90 + +random.o: random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} random.f90 + +geometry.o: geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry.f90 + +md_calc.o: md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} md_calc.f90 + +io_base.o: io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_base.f90 + +energy.o: energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} energy.f90 + +check_bond.o: check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} check_bond.f90 + +control.o: control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control.f90 + +io_config.o: io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} io_config.f90 + +MPI.o: MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI.f90 + +minim.o: minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} minim.f90 + +regularize.o: regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} regularize.f90 + +compare.o: compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare.f90 + +map.o: map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map.f90 + +muca_md.o: muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} muca_md.f90 + +REMD.o: REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} REMD.f90 + +MCM_MD.o: MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_MD.f90 + +io.o: io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io.f90 + +MD.o: MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} MD.f90 + +MREMD.o: MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MREMD.f90 + +CSA.o: CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA.f90 + +unres.o: unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} unres.f90 diff --git a/source/unres/Makefile_old b/source/unres/Makefile_old new file mode 100644 index 0000000..887f608 --- /dev/null +++ b/source/unres/Makefile_old @@ -0,0 +1,219 @@ +################################################################### +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users2/emilial/UNRES/new_F90/source/unres_MD-M + +FC= ${INSTALL_DIR}/bin/mpif90 + +OPT = -O3 -ip + +#FFLAGS = -fpp -c ${OPT} -I$(INSTALL_DIR)/include +#-mcmodel large -check arg_temp_created -heap-arrays -recursive +FFLAGS = -fpp -c ${OPT} #-auto +#FFLAGS = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer +#FFLAGSm = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +#FFLAGS_ = -fpp -c -g -CA -CB -zero -traceback -u -check pointer -check uninit +FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -traceback -u -check pointer -check uninit +#FFLAGS1 = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +#FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zero -traceback -u -check uninit -check pointer -O3 -ipo -opt_report #-g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-I$(INSTALL_DIR)/include +#FFLAGSE = -fpp -c -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit #-O3 -ipo -opt_report + +#CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +# -lmpl only necessary for mpich2-1.4.1p1_intel +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -lmpl + +ARCH = LINUX +PP = /lib/cpp -P + +#EXE_FILE = unres_MD-M_E0LL2Y_F90_EL.exe + + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y; or NOMPI" + +.SUFFIXES: .f90 +.f90.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.f90 + +objects = xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o \ + CSA_data.o energy_data.o geometry_data.o map_data.o \ + MCM_data.o MD_data.o minim_data.o MPI_data.o REMD_data.o comm_local.o \ + prng_32.o math.o random.o geometry.o md_calc.o io_base.o energy.o check_bond.o muca_md.o\ + control.o io_config.o MPI.o minim.o \ + regularize.o compare.o map.o REMD.o MCM_MD.o io.o \ + MD.o MREMD.o CSA.o unres.o + + +#${EXE_FILE}: ${objects} +# ${FC} ${OPT} ${objects} -o ${EXE_FILE} + +no_option: + +#NMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN +NOMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 +#NOMPI: EXE_FILE = ../../bin/unres_MD-M_NO_MPI_F90_EL.exe +NOMPI: EXE_FILE = ../../bin/unres_NO_MPI_F90_EL.exe + +NOMPI: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${objects} cinfo.o -o ${EXE_FILE} + +# ${FC} ${objects} -Xlinker -M -o ${EXE_FILE} +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +#GAB: EXE_FILE = ../../bin/unres_MD-M_GAB_F90_EL_opt3.exe +GAB: EXE_FILE = ../../bin/unres_GAB_F90_EL.exe +GAB: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +#4P: EXE_FILE = ../../bin/unres_MD-M_4P_F90_EL_opt3.exe +4P: EXE_FILE = ../../bin/unres_4P_F90_EL.exe +4P: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 +#E0LL2Y: EXE_FILE = ../../bin/unres_MD-M_E0LL2Y_F90_EL_opt3.exe +E0LL2Y: EXE_FILE = ../../bin/unres_E0LL2Y_F90_EL.exe +E0LL2Y: ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + ${FC} ${OPT} ${objects} cinfo.o -o ${EXE_FILE} + + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm -f compinfo && cd xdrf && make clean +# rm -f *.o && rm -f *.mod && rm ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean + + +names.o: names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} names.f90 + +io_units.o: io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_units.f90 + +calc_data.o: calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} calc_data.f90 + +compare_data.o: compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare_data.f90 + +control_data.o: control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control_data.f90 + +CSA_data.o: CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA_data.f90 + +energy_data.o: energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} energy_data.f90 + +geometry_data.o: geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry_data.f90 + +map_data.o: map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map_data.f90 + +MCM_data.o: MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_data.f90 + +MD_data.o: MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MD_data.f90 + +minim_data.o: minim_data.f90 + ${FC} ${FFLAGSm} ${CPPFLAGS} minim_data.f90 + +MPI_data.o: MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI_data.f90 + +REMD_data.o: REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} REMD_data.f90 + +comm_local.o: comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} comm_local.f90 + +prng_32.o: prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} prng_32.f90 + +math.o: math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} math.f90 + +random.o: random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} random.f90 + +geometry.o: geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} geometry.f90 + +md_calc.o: md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} md_calc.f90 + +io_base.o: io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_base.f90 + +energy.o: energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} energy.f90 + +check_bond.o: check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} check_bond.f90 + +control.o: control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} control.f90 + +io_config.o: io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} io_config.f90 + +MPI.o: MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MPI.f90 + +minim.o: minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} minim.f90 + +regularize.o: regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} regularize.f90 + +compare.o: compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} compare.f90 + +map.o: map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} map.f90 + +muca_md.o: muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} muca_md.f90 + +REMD.o: REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} REMD.f90 + +MCM_MD.o: MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MCM_MD.f90 + +io.o: io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io.f90 + +MD.o: MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} MD.f90 + +MREMD.o: MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} MREMD.f90 + +CSA.o: CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} CSA.f90 + +unres.o: unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} unres.f90 diff --git a/source/unres/REMD.f90 b/source/unres/REMD.f90 index e1cf84c..edbcc8e 100644 --- a/source/unres/REMD.f90 +++ b/source/unres/REMD.f90 @@ -25,7 +25,7 @@ use comm_cipiszcze use energy_data use geometry_data, only: nres - use control_data + use control_data !el, only: mucadyn,lmuca #ifdef MPI include 'mpif.h' real(kind=8) :: time00 @@ -387,7 +387,7 @@ enddo enddo endif - deallocate(Gcopy) +! deallocate(Gcopy) return end subroutine setup_MD_matrices !----------------------------------------------------------------------------- diff --git a/source/unres/REMD_data.f90 b/source/unres/REMD_data.f90 deleted file mode 100644 index 3527922..0000000 --- a/source/unres/REMD_data.f90 +++ /dev/null @@ -1,26 +0,0 @@ - module REMD_data -!----------------------------------------------------------------------------- -! Maximum number of conformation stored in cache on each CPU before sending -! to master; depends on nstex / ntwx ratio - integer,parameter :: max_cache_traj=10 -!----------------------------------------------------------------------------- -! commom.remd -! common /remdcommon/ - integer :: nrep,nstex,i_sync_step - real(kind=8) :: retmin,retmax - real(kind=8),dimension(:),allocatable :: remd_t !(maxprocs) - logical :: remd_tlist,remd_mlist,mremdsync,restart1file,traj1file - integer,dimension(:),allocatable :: remd_m !(maxprocs) -! common /remdrestart/ - integer(kind=2),dimension(:),allocatable :: i2rep !,i2set !(0:maxprocs) -! common /traj1cache/ - integer :: max_cache_traj_use -!----------------------------------------------------------------------------- -! common /przechowalnia/ subroutines: friction_force,setup_fricmat -! real(kind=8),dimension(:,:),allocatable :: ginvfric !(2*nres,2*nres) !maxres2=2*maxres -!----------------------------------------------------------------------------- -! common /przechowalnia/ subroutine: setup_fricmat -! real(kind=8),dimension(:,:),allocatable :: fcopy !(2*nres,2*nres) -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module REMD_data diff --git a/source/unres/calc_data.f90 b/source/unres/calc_data.f90 deleted file mode 100644 index 5f77393..0000000 --- a/source/unres/calc_data.f90 +++ /dev/null @@ -1,14 +0,0 @@ - module calc_data -!----------------------------------------------------------------------------- -! commom.calc common/calc/ - integer :: i,j,k,l - real(kind=8) :: 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 - real(kind=8),dimension(3) :: erij,gg -!----------------------------------------------------------------------------- - end module calc_data diff --git a/source/unres/cinfo.f90 b/source/unres/cinfo.f90 index 599aea2..5d88fbc 100644 --- a/source/unres/cinfo.f90 +++ b/source/unres/cinfo.f90 @@ -1,28 +1,33 @@ ! DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C -! 0 40376 11 +! 0 40376 49 subroutine cinfo ! include 'COMMON.IOUNITS' use io_units write(iout,*)'++++ Compile info ++++' - write(iout,*)'Version 0.40376 build 11' - write(iout,*)'compiled Tue Jul 14 17:03:26 2015' - write(iout,*)'compiled by emilial@mmka' + write(iout,*)'Version 0.40376 build 49' + write(iout,*)'compiled Fri Oct 14 14:36:02 2016' + write(iout,*)'compiled by emilial@piasek4' write(iout,*)'OS name: Linux ' - write(iout,*)'OS release: 3.2.0-79-generic ' + write(iout,*)'OS release: 3.2.0-111-generic ' write(iout,*)'OS version:',& - ' #115-Ubuntu SMP Thu Mar 12 14:18:19 UTC 2015 ' + ' #153-Ubuntu SMP Wed Sep 21 21:23:31 UTC 2016 ' write(iout,*)'flags:' write(iout,*)'INSTALL_DIR = /users/software/mpich2-1.4.1p1_in...' write(iout,*)'FC= ${INSTALL_DIR}/bin/mpif90' write(iout,*)'OPT = -O3 -ip ' - write(iout,*)'FFLAGS = -fpp -c ${OPT}' - write(iout,*)'FFLAGSm = -fpp -c -O' - write(iout,*)'FFLAGS1 = -fpp -c -g -CA -CB' - write(iout,*)'FFLAGS2 = -fpp -c -g -O0' - write(iout,*)'FFLAGSE = -fpp -c ${OPT}' + write(iout,*)'FFLAGS = -fpp -c ${OPT} #-auto' + write(iout,*)'FFLAGSm = -fpp -c -O #-g -CA -CB -auto -zero -t...' + write(iout,*)'FFLAGS1 = -fpp -c -g -CA -CB #-auto #-zero -tra...' + write(iout,*)'FFLAGS2 = -fpp -c -g -O0 #-I$(INSTALL_DIR)/inc...' + write(iout,*)'FFLAGSE = -fpp -c ${OPT} #-g -CA -CB -auto -zer...' write(iout,*)'ARCH = LINUX' write(iout,*)'PP = /lib/cpp -P' - write(iout,*)'objects = ../xdrf/*.o names.o io_units.o calc_d...' + write(iout,*)'DATA_FILE= ./data' + write(iout,*)'data = names.o io_units.o calc_data.o compare_d...' + write(iout,*)'objects = xdrf/*.o \\' + write(iout,*)' prng_32.o math.o random.o geometry.o md_calc.o...' + write(iout,*)'NOMPI: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD6...' + write(iout,*)'NOMPI: EXE_FILE = ../../bin/unres_NO_MPI_F90_EL...' write(iout,*)'GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 ...' write(iout,*)'GAB: EXE_FILE = ../../bin/unres_GAB_F90_EL.exe' write(iout,*)'4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -D...' diff --git a/source/unres/comm_local.f90 b/source/unres/comm_local.f90 deleted file mode 100644 index 8a1c833..0000000 --- a/source/unres/comm_local.f90 +++ /dev/null @@ -1,102 +0,0 @@ - module comm_locel -! commom /locel/ - integer :: num_conti,j1,j2 - real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,& - dz_normi,xmedi,ymedi,zmedi - real(kind=8),dimension(2,2) :: a_temp - real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1 - - end module comm_locel -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_calcthet -! commom /calcthet/ - integer :: it - real(kind=8) :: term1,term2,termm,diffak,ratak,& - ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,& - delthe0,sig0inv,sigtc,sigsqtc,delthec - end module comm_calcthet -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_sccalc -! commom /sccalc/ - integer :: it,nlobit - real(kind=8) :: time11,time12,time112,theti - end module comm_sccalc -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_chu -! common /chuju/ - integer :: jjj - end module comm_chu -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_gucio -! common /gucio/ - real(kind=8),dimension(3) :: cm - end module comm_gucio -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_cipiszcze -! common /cipiszcze/ - integer :: itt_comm - end module comm_cipiszcze -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_przech -! common /przechowalnia/ - integer :: nbond - end module comm_przech -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_iofile -! common /IOFILE/ - integer :: IODA(400) - integer :: IR,IW,IP,IJK,IPK,IDAF,NAV - end module comm_iofile -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_machsw -! common /MACHSW/ - integer :: KDIAG,ICORFL,IXDR - end module comm_machsw -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_par -! common /PAR / - LOGICAL :: GOPARR,DSKWRK,MASWRK - integer :: ME,MASTER,NPROC,IBTYP,IPTIM - end module comm_par -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_srutu -! common /srutu/ - integer :: icall - end module comm_srutu -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_vrandd -! common /VRANDD/ - integer,dimension(250) :: A - integer :: I,I147 - end module comm_vrandd -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_kut -! common /kutas/ - logical :: lprn - end module comm_kut -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - module comm_syfek -! common /syfek/ -! in subroutines: friction_force,setup_fricmat - real(kind=8),dimension(:),allocatable :: gamvec !(MAXRES6) or (MAXRES2) - end module comm_syfek -!----------------------------------------------------------------------------- - module comm_sschecks -! common /sschecks/ checkstop,transgrad - logical :: checkstop,transgrad - end module comm_sschecks -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- diff --git a/source/unres/compare.f90 b/source/unres/compare.f90 index e876834..05bedc0 100644 --- a/source/unres/compare.f90 +++ b/source/unres/compare.f90 @@ -5,7 +5,7 @@ use geometry_data use energy_data use control_data -#ifndef WHAM_RUN +#if .not. defined WHAM_RUN && .not. defined CLUSTER use compare_data use io_base use io_config @@ -21,7 +21,7 @@ ! !----------------------------------------------------------------------------- contains -#ifndef WHAM_RUN +#if .not. defined WHAM_RUN && .not. defined CLUSTER !----------------------------------------------------------------------------- ! contact.f !----------------------------------------------------------------------------- @@ -237,7 +237,6 @@ ! enddo enddo endif -!elwrite(iout,*) "nharp=", nharp,"nres/3",nres/3 return end subroutine hairpin !----------------------------------------------------------------------------- @@ -362,7 +361,6 @@ write (iout,*) write (iout,*) 'Electrostatic contacts before pruning: ' do i=1,ncont -!elwrite(iout,*) "petla",i i1=icont(1,i) i2=icont(2,i) it1=itype(i1) @@ -371,7 +369,6 @@ i,restyp(it1),i1,restyp(it2),i2,econt(i) enddo endif -!elwrite(iout,*)"po petli" ! For given residues keep only the contacts with the greatest energy. i=0 do while (i.lt.ncont) @@ -450,7 +447,6 @@ write (iout,*) write (iout,*) 'Electrostatic contacts after pruning: ' do i=1,ncont -!elwrite(iout,*) "petla",i i1=icont(1,i) i2=icont(2,i) it1=itype(i1) @@ -459,7 +455,6 @@ i,restyp(it1),i1,restyp(it2),i2,econt(i) enddo endif -!elwrite(iout,*) "koniec elecont" return end subroutine elecont !----------------------------------------------------------------------------- @@ -484,10 +479,8 @@ !el allocate(icont(2,12*nres),isec(nres,4),nsec(nres)) -!elwrite(iout,*)"przed chainbuild" if(.not.dccart) call chainbuild if(.not.allocated(hfrag)) allocate(hfrag(2,nres/3)) !(2,maxres/3) -!elwrite(iout,*)"po chainbuild" !d call write_pdb(99,'sec structure',0d0) ncont=0 nbfrag=0 @@ -576,7 +569,6 @@ enddo ! finding alpha or 310 helix -!elwrite(iout,*) "findings helix" nhelix=0 do i=1,ncont i1=icont(1,i) @@ -611,21 +603,15 @@ if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80) & not_done=.false. !d -!el write (iout,*) i1,j1,not_done,p1,p2 enddo j1=j1+1 if (j1-ii1.gt.5) then nhelix=nhelix+1 !d -!elwrite (iout,*)'helix',nhelix,ii1,j1 nhfrag=nhfrag+1 -!elwrite(iout,*) nhfrag hfrag(1,nhfrag)=ii1 -!elwrite (iout,*)'helix',nhelix,ii1,j1,hfrag(1,nhfrag) -!elwrite (iout,*)'helix',nhelix,ii1,j1 hfrag(2,nhfrag)=j1 -!elwrite (iout,*)'helix',nhelix,ii1,j1 do ij=ii1,j1 nsec(ij)=-1 @@ -645,7 +631,6 @@ endif endif enddo -!elwrite(iout,*) "po find helix" if (nhelix.gt.0.and.lprint) then write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" do i=2,nhelix @@ -830,6 +815,7 @@ ! & obr,non_conv) ! rms=dsqrt(rms) call rmsd(rms) +!elte(iout,*) "rms_nacc before contact" 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) @@ -1012,6 +998,7 @@ !----------------------------------------------------------------------------- subroutine test +!el use minim use geometry, only:pinorm use random, only:ran_number,iran_num ! implicit real*8 (a-h,o-z) @@ -1131,6 +1118,7 @@ !el#ifdef MPI subroutine test_n16 +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -1326,6 +1314,7 @@ subroutine test11 use geometry, only:dist +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -2032,6 +2021,7 @@ subroutine test3 use geometry, only:dist +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -2220,6 +2210,7 @@ !----------------------------------------------------------------------------- subroutine test__ +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -2679,6 +2670,7 @@ subroutine contact_cp2(var,var2,iff,ieval,in_pdb) use geometry, only:dist +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -2833,6 +2825,7 @@ subroutine contact_cp(var,var2,iff,ieval,in_pdb) use geometry, only:dist +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.SBRIDGE' @@ -3003,6 +2996,11 @@ end subroutine contact_cp !----------------------------------------------------------------------------- subroutine contact_cp_min(var,ieval,in_pdb,linia,debug) + +!el use minim +! +! input : theta,phi,alph,omeg,in_pdb,linia,debug +! output : var,ieval ! ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' @@ -3282,6 +3280,7 @@ subroutine softreg use geometry, only:dist +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -3540,6 +3539,7 @@ subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij) use geometry, only:dist +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -3704,6 +3704,7 @@ !----------------------------------------------------------------------------- subroutine beta_zip(i1,i2,ieval,ij) +!el use minim ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' include 'mpif.h' @@ -4151,6 +4152,7 @@ subroutine sc_conf ! Sample (hopefully) optimal SC orientations given backcone conformation. +!el use comm_srutu use random, only:iran_num ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' diff --git a/source/unres/compare_data.f90 b/source/unres/compare_data.f90 deleted file mode 100644 index 0a480c5..0000000 --- a/source/unres/compare_data.f90 +++ /dev/null @@ -1,50 +0,0 @@ - module compare_data -!----------------------------------------------------------------------------- -! Max. number of threading attempts - integer,parameter :: maxthread=20 -!----------------------------------------------------------------------------- -! Max. number of residues in a peptide in the database - integer,parameter :: maxres_base=10 -!----------------------------------------------------------------------------- -! commom.chain -! common /from_zscore/ - integer :: nz_start,nz_end,iz_sc -!----------------------------------------------------------------------------- -! common.dbase -! common /struct/ - real(kind=8),dimension(:,:,:),allocatable :: cart_base !(3,maxres_base,maxseq) - integer,dimension(:,:),allocatable :: nres_base !(3,maxseq) - integer :: nseq - character(len=8),dimension(:),allocatable :: str_nam !(maxseq) -!----------------------------------------------------------------------------- -! common.distfit -! parameter (maxres22=maxres*(maxres+1)/2) - integer :: maxres22 -! COMMON /c_frag/ - integer :: nbfrag,nhfrag - integer,dimension(:,:),allocatable :: bfrag !(4,maxres/3) - integer,dimension(:,:),allocatable :: hfrag !(2,maxres/3) -! COMMON /frag/ in module CSA -! COMMON /WAGI/ - real(kind=8),dimension(:),allocatable :: w,d0 -! COMMON /POCHODNE/ - integer :: NX,NY - real(kind=8),dimension(:,:),allocatable :: DRDG !(MAXRES22,MAXRES) - real(kind=8),dimension(:),allocatable :: DDD !(maxres22) - real(kind=8),dimension(:,:),allocatable :: H !(MAXRES,MAXRES) - real(kind=8),dimension(:),allocatable :: XX !(MAXRES) -! COMMON /frozen/ - integer,dimension(:),allocatable :: mask !(maxres) -! COMMON /store0/ - integer :: nhpb0 -!----------------------------------------------------------------------------- -! common.thread -! common /thread/ - integer :: nthread,nexcl - integer,dimension(:,:),allocatable :: iexam,ipatt !(2,maxthread) -! common /thread1/ - real(kind=8),dimension(:,:),allocatable :: ener0,ener !(n_ene+2,maxthread) - real(kind=8) :: max_time_for_thread,ave_time_for_thread -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module compare_data diff --git a/source/unres/control.f90 b/source/unres/control.f90 index a8b0df6..8d22bf0 100644 --- a/source/unres/control.f90 +++ b/source/unres/control.f90 @@ -7,13 +7,26 @@ use energy_data use control_data use minim_data - use csa_data use geometry, only:int_bounds +#ifndef CLUSTER + use csa_data #ifdef WHAM_RUN use wham_data #endif +#endif implicit none !----------------------------------------------------------------------------- +! commom.control +! common /cntrl/ +! integer :: modecalc,iscode,indpdb,indback,indphi,iranconf,& +! icheckgrad,iprint,i2ndstr,mucadyn,constr_dist,symetr +! 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 +!... minim = .true. means DO minimization. +!... energy_dec = .true. means print energy decomposition matrix +!----------------------------------------------------------------------------- ! common.time1 ! FOUND_NAN - set by calcf to stop sumsl via stopx ! COMMON/TIME1/ @@ -26,6 +39,16 @@ logical :: FOUND_NAN ! common /timing/ real(kind=8) :: t_init +! time_bcast,time_reduce,time_gather,& +! time_sendrecv,time_barrier_e,time_barrier_g,time_scatter,& + !t_eelecij, +! time_allreduce,& +! time_lagrangian,time_cartgrad,& +! time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart,& +! time_mat,time_fricmatmult,& +! time_scatter_fmat,time_scatter_ginv,& +! time_scatter_fmatmult,time_scatter_ginvmult,& +! t_eshort,t_elong,t_etotal !----------------------------------------------------------------------------- ! initialize_p.F !----------------------------------------------------------------------------- @@ -38,8 +61,9 @@ !el real(kind=8) :: cPoise=2.9361d0, Rb=0.001986d0 !----------------------------------------------------------------------------- ! common /przechowalnia/ subroutines: init_int_table,add_int,add_int_from - integer,dimension(:),allocatable :: iturn3_start_all,iturn3_end_all,& - iturn4_start_all,iturn4_end_all,iatel_s_all,iatel_e_all !(0:max_fg_procs) + integer,dimension(:),allocatable :: iturn3_start_all,& + iturn3_end_all,iturn4_start_all,iturn4_end_all,iatel_s_all,& + iatel_e_all !(0:max_fg_procs) integer,dimension(:,:),allocatable :: ielstart_all,& ielend_all !(maxres,0:max_fg_procs-1) @@ -99,7 +123,7 @@ !local variables el integer :: i,j,k,l,ichir1,ichir2,iblock,m,maxit -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) mask_r=.false. #ifndef ISNAN ! NaNQ initialization @@ -107,7 +131,7 @@ rr=dacos(100.0d0) #ifdef WINPGI idumm=proc_proc(rr,i) -#else +#elif defined(WHAM_RUN) call proc_proc(rr,i) #endif #endif @@ -131,6 +155,9 @@ deg2rad=pi/180.0D0 rad2deg=1.0D0/deg2rad angmin=10.0D0*deg2rad +!el#ifdef CLUSTER +!el Rgas = 1.987D-3 +!el#endif ! ! Define I/O units. ! @@ -138,36 +165,62 @@ iout= 2 ipdbin= 3 ipdb= 7 +#ifdef CLUSTER + imol2= 18 + jplot= 19 +!el jstatin=10 + imol2= 4 + jrms=30 +#else icart = 30 imol2= 4 + ithep_pdb=51 + irotam_pdb=52 + irest1=55 + irest2=56 + iifrag=57 + ientin=18 + ientout=19 +!rc for write_rmsbank1 + izs1=21 +!dr include secondary structure prediction bias + isecpred=27 +#endif igeom= 8 intin= 9 ithep= 11 - ithep_pdb=51 irotam=12 - irotam_pdb=52 itorp= 13 itordp= 23 ielep= 14 isidep=15 -#ifdef WHAM_RUN +#if defined(WHAM_RUN) || defined(CLUSTER) isidep1=22 !wham +#else +! +! CSA I/O units (separated from others especially for Jooyoung) +! + 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 +!rc for ifc error 118 + icsa_pdb=42 #endif iscpp=25 icbase=16 ifourier=20 istat= 17 - irest1=55 - irest2=56 - iifrag=57 - ientin=18 - ientout=19 ibond = 28 isccor = 29 -!rc for write_rmsbank1 - izs1=21 -!dr include secondary structure prediction bias - isecpred=27 #ifdef WHAM_RUN ! ! WHAM files @@ -175,6 +228,8 @@ ihist=30 iweight=31 izsc=32 +#endif +#if defined(WHAM_RUN) || defined(CLUSTER) ! ! setting the mpi variables for WHAM ! @@ -183,23 +238,6 @@ nfgtasks1=1 #endif ! -! CSA I/O units (separated from others especially for Jooyoung) -! - 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 -!rc for ifc error 118 - icsa_pdb=42 -! ! Set default weights of the energy terms. ! wsc=1.0D0 ! in wham: wlong=1.0D0 @@ -345,16 +383,8 @@ nfl=0 icg=1 -!el if (run_wham) then !el #ifdef WHAM_RUN - ndih_constr=0 - -! allocate(ww0(max_eneW)) -! ww0 = reshape((/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/), shape(ww0)) -! -! allocate(iww(max_eneW)) + allocate(iww(max_eneW)) do i=1,14 do j=1,14 if (print_order(i).eq.j) then @@ -364,6 +394,16 @@ enddo 1121 continue enddo +#endif + +#if defined(WHAM_RUN) || defined(CLUSTER) + ndih_constr=0 + +! allocate(ww0(max_eneW)) +! ww0 = reshape((/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/), shape(ww0)) +! calc_grad=.false. ! Set timers and counters for the respective routines t_func = 0.0d0 @@ -399,6 +439,7 @@ subroutine init_int_table use geometry, only:int_bounds1 +!el use MPI_data !el implicit none ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' @@ -453,16 +494,18 @@ !... Determine the numbers of start and end SC-SC interaction !... to deal with by current processor. +!write (iout,*) '******INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct do i=0,nfgtasks-1 itask_cont_from(i)=fg_rank itask_cont_to(i)=fg_rank enddo lprint=energy_dec +! lprint=.true. if (lprint) & - write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct + 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) -write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct +!write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct if (lprint) & write (iout,*) 'Processor',fg_rank,' CG group',kolor,& ' absolute rank',MyRank,& @@ -1279,19 +1322,19 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct iint_end=nres-1 #endif !el common /przechowalnia/ - deallocate(iturn3_start_all) - deallocate(iturn3_end_all) - deallocate(iturn4_start_all) - deallocate(iturn4_end_all) - deallocate(iatel_s_all) - deallocate(iatel_e_all) - deallocate(ielstart_all) - deallocate(ielend_all) +! deallocate(iturn3_start_all) +! deallocate(iturn3_end_all) +! deallocate(iturn4_start_all) +! deallocate(iturn4_end_all) +! deallocate(iatel_s_all) +! deallocate(iatel_e_all) +! deallocate(ielstart_all) +! deallocate(ielend_all) - deallocate(ntask_cont_from_all) - deallocate(ntask_cont_to_all) - deallocate(itask_cont_from_all) - deallocate(itask_cont_to_all) +! deallocate(ntask_cont_from_all) +! deallocate(ntask_cont_to_all) +! deallocate(itask_cont_from_all) +! deallocate(itask_cont_to_all) !el---------- return end subroutine init_int_table @@ -1453,6 +1496,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct !----------------------------------------------------------------------------- subroutine add_task(iproc,ntask_cont,itask_cont) +!el use MPI_data !el implicit none ! include "DIMENSIONS" integer :: iproc,ntask_cont,itask_cont(0:nfgtasks-1) !(0:max_fg_procs-1) @@ -1509,6 +1553,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct end subroutine int_partition #endif !----------------------------------------------------------------------------- +#ifndef CLUSTER subroutine hpb_partition ! implicit real*8 (a-h,o-z) @@ -1531,8 +1576,9 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct #endif return end subroutine hpb_partition +#endif !----------------------------------------------------------------------------- -! misc.f in module io_common +! misc.f in module io_base !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! parmread.F @@ -1686,7 +1732,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct ! timlim=batime-150.0 ! Calculate the initial time, if it is not zero (e.g. for the SUN). stime=tcpu() -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) #ifdef MPI walltime=MPI_WTIME() time_reduce=0.0d0 @@ -1726,6 +1772,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct return end subroutine set_timers !----------------------------------------------------------------------------- +#ifndef CLUSTER logical function stopx(nf) ! This function returns .true. if one of the following reasons to exit SUMSL ! occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block: @@ -1827,6 +1874,69 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct return end function stopx !----------------------------------------------------------------------------- +#else + logical function stopx(nf) +! +! .................................................................. +! +! *****PURPOSE... +! THIS FUNCTION MAY SERVE AS THE STOPX (ASYNCHRONOUS INTERRUPTION) +! FUNCTION FOR THE NL2SOL (NONLINEAR LEAST-SQUARES) PACKAGE AT +! THOSE INSTALLATIONS WHICH DO NOT WISH TO IMPLEMENT A +! DYNAMIC STOPX. +! +! *****ALGORITHM NOTES... +! AT INSTALLATIONS WHERE THE NL2SOL SYSTEM IS USED +! INTERACTIVELY, THIS DUMMY STOPX SHOULD BE REPLACED BY A +! FUNCTION THAT RETURNS .TRUE. IF AND ONLY IF THE INTERRUPT +! (BREAK) KEY HAS BEEN PRESSED SINCE THE LAST CALL ON STOPX. +! +! $$$ MODIFIED FOR USE AS THE TIMER ROUTINE. +! $$$ WHEN THE TIME LIMIT HAS BEEN +! $$$ REACHED STOPX IS SET TO .TRUE AND INITIATES (IN ITSUM) +! $$$ AND ORDERLY EXIT OUT OF SUMSL. IF ARRAYS IV AND V ARE +! $$$ SAVED, THE SUMSL ROUTINES CAN BE RESTARTED AT THE SAME +! $$$ POINT AT WHICH THEY WERE INTERRUPTED. +! +! .................................................................. +! +! include 'DIMENSIONS' + integer :: nf +! logical ovrtim +! include 'COMMON.IOUNITS' +! include 'COMMON.TIME1' +#ifdef MPL +! include 'COMMON.INFO' + integer :: Kwita + +!d print *,'Processor',MyID,' NF=',nf +#endif + if (ovrtim()) then +! Finish if time is up. + stopx = .true. +#ifdef MPL + else if (mod(nf,100).eq.0) then +! Other processors might have finished. Check this every 100th function +! evaluation. +!d 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. + else + stopx=.false. + endif +#endif + else + stopx = .false. + endif + return + end function stopx +#endif +!----------------------------------------------------------------------------- logical function ovrtim() ! include 'DIMENSIONS' @@ -1950,6 +2060,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct return end function tcpu !----------------------------------------------------------------------------- +#ifndef CLUSTER subroutine dajczas(rntime,hrtime,mintime,sectime) ! include 'COMMON.IOUNITS' @@ -1974,6 +2085,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct !----------------------------------------------------------------------------- subroutine print_detailed_timing +!el use MPI_data ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI @@ -2042,6 +2154,7 @@ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct endif return end subroutine print_detailed_timing +#endif !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- end module control diff --git a/source/unres/control_data.f90 b/source/unres/control_data.f90 deleted file mode 100644 index 389412e..0000000 --- a/source/unres/control_data.f90 +++ /dev/null @@ -1,76 +0,0 @@ - module control_data -!----------------------------------------------------------------------------- -! Max. number of types of dihedral angles & multiplicity of torsional barriers -! and the number of terms in double torsionals - integer,parameter :: maxtor=4,maxterm=10,maxlor=3 - integer,parameter :: maxtermd_1=8,maxtermd_2=8 -!----------------------------------------------------------------------------- -! Max. number of groups of interactions that a given SC is involved in - integer,parameter :: maxint_gr=2 -!----------------------------------------------------------------------------- -! Max. number of residue types and parameters in expressions for -! virtual-bond angle bending potentials - integer,parameter :: maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20 - integer,parameter :: maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4 - integer,parameter :: mmaxtheterm=maxtheterm -!----------------------------------------------------------------------------- -! Max. number of S-S bridges - integer,parameter :: maxss=20 -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- -! commom.control -! common /cntrl/ - integer :: modecalc,iscode,indpdb,indback,indphi,iranconf,& - icheckgrad,iprint,i2ndstr,mucadyn,constr_dist,symetr - 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 -!... minim = .true. means DO minimization. -!... energy_dec = .true. means print energy decomposition matrix -!----------------------------------------------------------------------------- -! common.header -! common /header/ - character(len=80) :: titel -!----------------------------------------------------------------------------- -! common.spitele -! common /splitele/ - real(kind=8) :: r_cut,rlamb -!----------------------------------------------------------------------------- -! common.time1 -! FOUND_NAN - set by calcf to stop sumsl via stopx -! COMMON/TIME1/ - real(kind=8) :: TIMLIM,SAFETY,WALLTIME -! common /timing/ - real(kind=8) :: t_eelecij,t_enegrad,t_MDsetup,t_langsetup,t_MD,& - t_sdsetup,time_stoch,time_fric,time_fsample,time_sumene,& - time_enecalc,time_vec,time_bcast,time_reduce,time_gather,& - time_sendrecv,time_barrier_e,time_barrier_g,time_scatter,& - time_ginvmult,time_bcast7,time_bcastc,time_bcastw,& - time_allreduce,& - time_lagrangian,time_cartgrad,& - time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart,& - time_mat,time_fricmatmult,& - time_scatter_fmat,time_scatter_ginv,& - time_scatter_fmatmult,time_scatter_ginvmult,& - t_eshort,t_elong,t_etotal -#ifdef WHAM_RUN -! common /stoptim/ -!el integer :: WhatsUp,ndelta - integer :: ndelta - logical :: cutoffviol,cutoffeval,llocal -! common /timing/ wham -! Timers and counters for the respective routines - real(kind=8) :: t_func,t_grad,t_fhel,t_fbet,t_ghel,t_gbet,& - t_viol,t_gviol,t_map,t_alamap,t_betamap - integer :: n_func,n_grad,n_fhel,n_fbet,n_ghel,n_gbet,n_viol,& - n_gviol,n_map,n_alamap,n_betamap -#endif -!----------------------------------------------------------------------------- - integer,parameter :: MaxMoveType = 4 -!----------------------------------------------------------------------------- -! Max. number of processors. - integer,parameter :: maxprocs=2048 -!el integer,parameter :: maxprocs=4200 -!----------------------------------------------------------------------------- - end module control_data diff --git a/source/unres/data/CSA_data.f90 b/source/unres/data/CSA_data.f90 new file mode 100644 index 0000000..cd5835d --- /dev/null +++ b/source/unres/data/CSA_data.f90 @@ -0,0 +1,77 @@ + module csa_data +!----------------------------------------------------------------------------- +! Maximum number of generated conformations + integer,parameter :: mxio=1000 +! Maximum number of n7 generated conformations + integer,parameter :: mxio2=100 +! Maxmimum number of angles per residue + integer,parameter :: mxang=4 +! Maximum number of chains + integer,parameter :: mxch=1 +!----------------------------------------------------------------------------- +! commom.bank +! common/varin/ + real(kind=8),dimension(:,:,:,:),allocatable :: dihang_in !(mxang,maxres,mxch,mxio) +! common/minvar/ +! real(kind=8),dimension(:,:,:,:),allocatable :: dihang !(mxang,maxres,mxch,mxio) + real(kind=8),dimension(:),allocatable :: rmsn,pncn !(mxio) +! integer,dimension(:),allocatable :: nss_out !(mxio) +! integer,dimension(:,:),allocatable ::iss_out,jss_out !(maxss,mxio) +! common/bank/ + real(kind=8),dimension(:,:,:,:),allocatable :: rvar,bvar!(mxang,maxres,mxch,mxio) + real(kind=8),dimension(:),allocatable :: bene,rene,& + brmsn,rrmsn,bpncn,rpncn !(mxio) + integer,dimension(:),allocatable :: ibank!,is,jbank !(mxio) + real(kind=8) :: cutdif,&!,avedif,difmin,ebmin,ebmax,ebmaxt,& + dele,difcut,rmscut,pnccut +! real(kind=8),dimension(:,:),allocatable :: dij !(mxio,mxio) + integer :: ibmin,ibmax,nbank,ntbank,ntbankm,nconf,iuse,& + nstep,icycle,iseed,iref,nconf_in,ilastnstep,nadd +! common/bank_disulfid/ + integer,dimension(:),allocatable :: bvar_nss,bvar_ns !(mxio) + integer,dimension(:,:),allocatable :: bvar_s !(maxss,mxio) + integer,dimension(:,:,:),allocatable :: bvar_ss !(2,maxss,mxio) +!----------------------------------------------------------------------- +! common.iounits +! I/O units used by the program +!----------------------------------------------------------------------- +! 9/18/99 - unit ifourier and filename fouriername included to identify +! the file from which the coefficients of second-order Fourier expansion +! of the local-interaction energy are read. +! 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) +! included. +!----------------------------------------------------------------------- +! CSA I/O units & files +! common /csafiles/ + character(len=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 /csaunits/ + 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.csa + integer :: irestart,ndiff +! common/alphaa/ +! integer,dimension(:),allocatable :: ngroup !(mxgr) +! integer,dimension(:,:,:),allocatable :: igroup !(3,mxang,mxgr) + integer :: numch +! common/csa_input/ + real(kind=8) :: cut1,cut2,estop + real(kind=8) :: eglob_csa + integer :: jstart,jend,& + n1,n2,n3,n4,n5,n6,n7,n8,n9,n14,n15,n16,n17,n18,n0,& + is1,is2,nseed,ntotal,icmax,nstmax,nran0,nran1,irr + integer :: nglob_csa,nmin_csa +! common/dih_control/ + real(kind=8) :: rdih_bias +! common/diffcuta/ + real(kind=8) :: diffcut +!----------------------------------------------------------------------------- +! Maximum number of groups of angles + integer :: mxgr +!----------------------------------------------------------------------------- + real(kind=8) :: rmsdbc1 +!----------------------------------------------------------------------------- + end module csa_data diff --git a/source/unres/data/MCM_data.f90 b/source/unres/data/MCM_data.f90 new file mode 100644 index 0000000..b698318 --- /dev/null +++ b/source/unres/data/MCM_data.f90 @@ -0,0 +1,73 @@ + module mcm_data +!----------------------------------------------------------------------------- +! Max. number of stored confs. in MC/MCM simulation + integer,parameter :: maxsave=20 +!----------------------------------------------------------------------------- +! common.mce +! common /mce/ + real(kind=8) :: emin,emax + logical :: ent_read +! common /pool/ + real(kind=8) :: pool_fraction +! common /mce_counters/ + integer :: save_frequency,message_frequency,pool_read_freq,& + pool_save_freq,print_freq +!----------------------------------------------------------------------------- +! commom.mcm +!... Following COMMON block contains general variables controlling the MC/MCM +!... procedure +!----------------------------------------------------------------------------- +! common /mcm/ + real(kind=8) :: Tcur,Tmin,Tmax,TstepH,TstepC,RanFract,& + overlap_cut,e_up,delte,Rbol,betbol + integer :: nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,& + maxrepm,maxoverlap,ntrial,max_mcm_it,ngen,ntherm,nrepm,neneval,& + nsave,nsweep,print_mc + integer,dimension(:),allocatable :: nsave_part !(max_cg_procs) + logical :: print_stat,print_int +!----------------------------------------------------------------------------- +!... The meaning of the above variables is as follows: +!... Tcur,Tmin,Tmax - Current,minimum and maximum temperature, respectively; +!... NstepC,NStepH - Number of cooling and heating steps, respectively; +!... TstepH,TstepC - factors by which T is multiplied in order to be +!... increased or decreased. +!... betbol - Boltzmann's inverse temperature (1/(Rbol*Tcur)); +!... Rbol - the gas constant; +!... RanFract - the chance that a new conformation will be random-generated; +!... maxacc - maximum number of accepted conformations; +!... maxgen,ngen - Maximum and current number of generated conformations; +!... maxtrial,ntrial - maximum number of trials before temperature is increased +!... and current number of trials, respectively; +!... maxrepm,nrepm - maximum number of allowed minima repetition and current +!... number of minima repetitions, respectively; +!... maxoverlap - max. # of overlapping confs generated in a single iteration; +!... neneval - number of energy evaluations; +!... nsave - number of confs. in the backup array; +!... nsweep - the number of macroiterations in generating the distributions. +!------------------------------------------------------------------------------ +!... Following COMMON block contains variables controlling motion. +!------------------------------------------------------------------------------ +! common /move/ + real(kind=8),dimension(:),allocatable :: sumpro_type !(0:MaxMoveType) + integer :: nmove + integer,dimension(:),allocatable :: moves,moves_acc !(-1:MaxMoveType+1) +!... maxgen,ngen - Maximum and current number of generated conformations; +! common /accept_stats/ + integer :: nacc_tot +! common /windows/ + integer :: nwindow + integer,dimension(:),allocatable :: winstart,winend,winlen !(maxres) +! common /moveID/ + character(len=16),dimension(:),allocatable :: MovTypID !(-1:MaxMoveType+1) +!----------------------------------------------------------------------------- +! common.var +! Store the angles and variables corresponding to old conformations (for use +! in MCM). +! common /oldgeo/ + real(kind=8),dimension(:,:),allocatable :: varsave !(maxvar,maxsave)(maxvar=6*maxres) + real(kind=8),dimension(:),allocatable :: esave !(maxsave) + integer,dimension(:),allocatable :: Origin !(maxsave) + integer :: nstore +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module mcm_data diff --git a/source/unres/data/MD_data.f90 b/source/unres/data/MD_data.f90 new file mode 100644 index 0000000..bee0a24 --- /dev/null +++ b/source/unres/data/MD_data.f90 @@ -0,0 +1,100 @@ + module MD_data +!----------------------------------------------------------------------------- +#ifndef LANG0 +! commom.langevin +! common /langforc/ + real(kind=8),dimension(:,:),allocatable :: friction,stochforc !(3,0:MAXRES2) + real(kind=8),dimension(:),allocatable :: fric_work,stoch_work,& + fricgam !(MAXRES6) + real(kind=8),dimension(:,:),allocatable :: fricmat,fricvec,& + pfric_mat,vfric_mat,afric_mat,prand_mat,vrand_mat1,& + vrand_mat2 !(MAXRES2,MAXRES2) + real(kind=8),dimension(:,:,:),allocatable :: pfric0_mat,& + afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1,vrand0_mat2 !(MAXRES2,MAXRES2,0:maxflag_stoch) + logical,dimension(:),allocatable :: flag_stoch !(0:maxflag_stoch) +! common /langmat/ + real(kind=8),dimension(:,:),allocatable :: mt1,mt2,mt3 !(maxres2,maxres2) +!----------------------------------------------------------------------------- +#else +! commom.langevin.lang0 +! common /langforc/ + real(kind=8),dimension(:,:),allocatable :: friction,stochforc !(3,0:MAXRES2) + real(kind=8),dimension(:,:),allocatable :: fricmat,fricvec !(MAXRES2,MAXRES2) + real(kind=8),dimension(:),allocatable :: fric_work,stoch_work,& + fricgam !(MAXRES6) + logical,dimension(:),allocatable :: flag_stoch !(0:maxflag_stoch) + real(kind=8) :: vrand_mat1,vrand_mat2,prand_mat,vfric_mat,& + afric_mat,pfric_mat,pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,& + vrand0_mat1,vrand0_mat2 +! common /langmat/ + integer :: mt1,mt2,mt3 +#endif +!----------------------------------------------------------------------------- +! commom.hairpin in CSA module +!----------------------------------------------------------------------------- +! common.mce in MCM_MD module +!----------------------------------------------------------------------------- +! common.MD +! common /mdgrad/ in module.energy +! common /back_constr/ in module.energy +! common /qmeas/ in module.energy +! common /mdpar/ + real(kind=8) :: v_ini,d_time,d_time0,scal_fric,& + t_bath,tau_bath,dvmax,damax + integer :: n_timestep,ntime_split,ntime_split0,maxtime_split,& + ntwx,ntwe + logical :: mdpdb,large,print_compon,tbf,rest +! common /MDcalc/ + real(kind=8) :: totT,totE,potE,EK,amax,edriftmax,kinetic_T + real(kind=8),dimension(:),allocatable :: potEcomp !(0:n_ene+4) +! common /lagrange/ + real(kind=8),dimension(:,:),allocatable :: d_t,d_a,d_t_old !(3,0:MAXRES2) + real(kind=8),dimension(:),allocatable :: d_a_work !(6*MAXRES) + real(kind=8),dimension(:,:),allocatable :: Gmat,Ginv,A,& + Gsqrp,Gsqrm,Gvec !(maxres2,maxres2) + real(kind=8),dimension(:),allocatable :: Geigen !(maxres2) + real(kind=8),dimension(:),allocatable ::vtot !(maxres2) + logical :: reset_moment,reset_vel,rattle,RESPA + integer :: dimen,dimen1,dimen3 + integer :: lang,count_reset_moment,count_reset_vel +! common /inertia/ + real(kind=8) :: IP,mp + real(kind=8),dimension(:),allocatable :: ISC,msc !(ntyp+1) +! common /langevin/ + real(kind=8) :: rwat,etawat,stdfp,pstok,gamp!,Rb + real(kind=8) :: cPoise=2.9361d0, Rb=0.001986d0 + real(kind=8),dimension(:),allocatable :: gamsc !(ntyp1) + real(kind=8),dimension(:),allocatable :: stdfsc !(ntyp) + + real(kind=8),dimension(:),allocatable :: restok !(ntyp+1) + logical :: surfarea + integer :: reset_fricmat +! common /mdpmpi/ + integer :: igmult_start,igmult_end,my_ng_count,myginv_ng_count + integer,dimension(:),allocatable :: ng_start,ng_counts,& + nginv_counts !(0:MaxProcs-1) + integer,dimension(:),allocatable :: nginv_start !(0:MaxProcs) +!----------------------------------------------------------------------------- +! common.muca +! common /double_muca/ + real(kind=8) :: elow,ehigh,factor,hbin,factor_min + real(kind=8),dimension(:),allocatable :: emuca,nemuca,& + nemuca2,hist !(4*maxres) +! common /integer_muca/ + integer :: nmuca,imtime,muca_smooth +! common /mucarem/ + real(kind=8),dimension(:),allocatable :: elowi,ehighi !(maxprocs) +!----------------------------------------------------------------------------- +! Maximum number of timesteps for which stochastic MD matrices can be stored + integer,parameter :: maxflag_stoch=0 +!----------------------------------------------------------------------------- +! common /przechowalnia/ subroutines: setup_MD_matrices + real(kind=8),dimension(:,:),allocatable :: Gcopy !(maxres2,maxres2), maxres2=2*maxres +!----------------------------------------------------------------------------- +! common /przechowalnia/ subroutines: setup_fricmat,setup_MD_matrices + real(kind=8),dimension(:),allocatable :: Ghalf +!----------------------------------------------------------------------------- +! COMMON /BANII/ D + real(kind=8),DIMENSION(:),allocatable :: D_ban !(MAXRES6) maxres6=6*maxres +!----------------------------------------------------------------------------- + end module MD_data diff --git a/source/unres/data/MPI_data.f90 b/source/unres/data/MPI_data.f90 new file mode 100644 index 0000000..3ed522b --- /dev/null +++ b/source/unres/data/MPI_data.f90 @@ -0,0 +1,54 @@ + module MPI_data + +!----------------------------------------------------------------------------- + integer,parameter :: max_cg_procs=2048 +!----------------------------------------------------------------------------- +! commom.info +! NPROCS - total number of processors; +! MyID - processor's ID; +! MasterID - master processor's ID. + integer :: tag + integer,dimension(:),allocatable :: status !(MPI_STATUS_SIZE) +! common /info/ + integer :: myid,masterid,allgrp,dontcare,WhatsUp + logical,dimension(:),allocatable :: koniec !(0:maxprocs-1) +!el integer,dimension(:),allocatable :: ifinish !(maxprocs-1) +!... 5/12/96 - added variables for collective communication +! FGPROCS - Number of fine-grain processors per coarse-grain task; +! NCTASKS - Number of coarse-grain tasks; +! MYGROUP - label of the processor's FG group id; +! BOSSID - ID of group's master; +! FGLIST - list of group's FG processors. +! MSGLEN_VAR - length of the vector of variables passed to the fine-grain +! slave processors +! common /info1/ + integer :: fgprocs,nctasks,mygroup,bossid,cglabel,& + cgGroupID,fgGroupID,msglen_var + integer,dimension(:),allocatable :: cglist,fglist !(max_fg_procs) !not used ??? +!----------------------------------------------------------------------------- +! common.setup + integer,parameter :: king=0,idint=1105 + integer,parameter :: idreal=1729,idchar=1597,is_done=1 +! common/setup/ + integer :: me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,& + kolor,nfgtasks1,MyRank,kolor1,key1,max_gs_size,& + CG_COMM,FG_COMM,FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM +!el integer,dimension(:),allocatable :: koniec !(0:maxprocs-1) + integer,dimension(:),allocatable :: lentyp !(0:maxprocs-1) + integer,dimension(:),allocatable :: ifinish !(maxprocs-1) + logical :: yourjob,finished,cgdone +! common /types/ + integer :: MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,& + MPI_THET,MPI_GAM + integer,dimension(0:1) :: MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,& + MPI_PRECOMP11,MPI_PRECOMP12,MPI_PRECOMP22,MPI_PRECOMP23 +!----------------------------------------------------------------------------- +#if defined(WHAM_RUN) || defined(CLUSTER) +! COMMON.MPI +! common /MPI_Data/ + integer :: Master,Master1,Comm1,Me1,Nprocs1,WHAM_COMM + integer,dimension(:),allocatable :: Indstart,Indend,idispl,& + scount !(0:MaxProcs) +#endif +!----------------------------------------------------------------------------- + end module MPI_data diff --git a/source/unres/data/REMD_data.f90 b/source/unres/data/REMD_data.f90 new file mode 100644 index 0000000..3527922 --- /dev/null +++ b/source/unres/data/REMD_data.f90 @@ -0,0 +1,26 @@ + module REMD_data +!----------------------------------------------------------------------------- +! Maximum number of conformation stored in cache on each CPU before sending +! to master; depends on nstex / ntwx ratio + integer,parameter :: max_cache_traj=10 +!----------------------------------------------------------------------------- +! commom.remd +! common /remdcommon/ + integer :: nrep,nstex,i_sync_step + real(kind=8) :: retmin,retmax + real(kind=8),dimension(:),allocatable :: remd_t !(maxprocs) + logical :: remd_tlist,remd_mlist,mremdsync,restart1file,traj1file + integer,dimension(:),allocatable :: remd_m !(maxprocs) +! common /remdrestart/ + integer(kind=2),dimension(:),allocatable :: i2rep !,i2set !(0:maxprocs) +! common /traj1cache/ + integer :: max_cache_traj_use +!----------------------------------------------------------------------------- +! common /przechowalnia/ subroutines: friction_force,setup_fricmat +! real(kind=8),dimension(:,:),allocatable :: ginvfric !(2*nres,2*nres) !maxres2=2*maxres +!----------------------------------------------------------------------------- +! common /przechowalnia/ subroutine: setup_fricmat +! real(kind=8),dimension(:,:),allocatable :: fcopy !(2*nres,2*nres) +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module REMD_data diff --git a/source/unres/data/calc_data.f90 b/source/unres/data/calc_data.f90 new file mode 100644 index 0000000..3f40fd0 --- /dev/null +++ b/source/unres/data/calc_data.f90 @@ -0,0 +1,14 @@ + module calc_data +!----------------------------------------------------------------------------- +! commom.calc common/calc/ + integer :: i,j,k,l + real(kind=8) :: 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 + real(kind=8),dimension(3) :: erij,gg +!----------------------------------------------------------------------------- + end module calc_data diff --git a/source/unres/data/comm_local.f90 b/source/unres/data/comm_local.f90 new file mode 100644 index 0000000..ad29715 --- /dev/null +++ b/source/unres/data/comm_local.f90 @@ -0,0 +1,103 @@ + module comm_locel +! commom /locel/ + + integer :: num_conti,j1,j2 + real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,& + dz_normi,xmedi,ymedi,zmedi + real(kind=8),dimension(2,2) :: a_temp + real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1 + + end module comm_locel +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_calcthet +! commom /calcthet/ + integer :: it + real(kind=8) :: term1,term2,termm,diffak,ratak,& + ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,& + delthe0,sig0inv,sigtc,sigsqtc,delthec + end module comm_calcthet +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_sccalc +! commom /sccalc/ + integer :: it,nlobit + real(kind=8) :: time11,time12,time112,theti + end module comm_sccalc +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_chu +! common /chuju/ + integer :: jjj + end module comm_chu +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_gucio +! common /gucio/ + real(kind=8),dimension(3) :: cm + end module comm_gucio +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_cipiszcze +! common /cipiszcze/ + integer :: itt_comm + end module comm_cipiszcze +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_przech +! common /przechowalnia/ + integer :: nbond + end module comm_przech +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_iofile +! common /IOFILE/ + integer :: IODA(400) + integer :: IR,IW,IP,IJK,IPK,IDAF,NAV + end module comm_iofile +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_machsw +! common /MACHSW/ + integer :: KDIAG,ICORFL,IXDR + end module comm_machsw +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_par +! common /PAR / + LOGICAL :: GOPARR,DSKWRK,MASWRK + integer :: ME,MASTER,NPROC,IBTYP,IPTIM + end module comm_par +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_srutu +! common /srutu/ + integer :: icall + end module comm_srutu +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_vrandd +! common /VRANDD/ + integer,dimension(250) :: A + integer :: I,I147 + end module comm_vrandd +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_kut +! common /kutas/ + logical :: lprn + end module comm_kut +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + module comm_syfek +! common /syfek/ +! in subroutines: friction_force,setup_fricmat + real(kind=8),dimension(:),allocatable :: gamvec !(MAXRES6) or (MAXRES2) + end module comm_syfek +!----------------------------------------------------------------------------- + module comm_sschecks +! common /sschecks/ checkstop,transgrad + logical :: checkstop,transgrad + end module comm_sschecks +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- diff --git a/source/unres/data/compare_data.f90 b/source/unres/data/compare_data.f90 new file mode 100644 index 0000000..e17790f --- /dev/null +++ b/source/unres/data/compare_data.f90 @@ -0,0 +1,51 @@ + module compare_data +!----------------------------------------------------------------------------- +! Max. number of threading attempts + integer,parameter :: maxthread=20 +!----------------------------------------------------------------------------- +! Max. number of residues in a peptide in the database + integer,parameter :: maxres_base=10 +!----------------------------------------------------------------------------- +! commom.chain +! common /from_zscore/ + integer :: nz_start,nz_end,iz_sc +!----------------------------------------------------------------------------- +! common.dbase +! common /struct/ + real(kind=8),dimension(:,:,:),allocatable :: cart_base !(3,maxres_base,maxseq) + integer,dimension(:,:),allocatable :: nres_base !(3,maxseq) + integer :: nseq + character(len=8),dimension(:),allocatable :: str_nam !(maxseq) +!----------------------------------------------------------------------------- +! common.distfit +! parameter (maxres22=maxres*(maxres+1)/2) +! integer, parameter :: maxres22=1 + integer :: maxres22 +! COMMON /c_frag/ + integer :: nbfrag,nhfrag + integer,dimension(:,:),allocatable :: bfrag !(4,maxres/3) + integer,dimension(:,:),allocatable :: hfrag !(2,maxres/3) +! COMMON /frag/ in module CSA +! COMMON /WAGI/ + real(kind=8),dimension(:),allocatable :: w,d0 +! COMMON /POCHODNE/ + integer :: NX,NY + real(kind=8),dimension(:,:),allocatable :: DRDG !(MAXRES22,MAXRES) + real(kind=8),dimension(:),allocatable :: DDD !(maxres22) + real(kind=8),dimension(:,:),allocatable :: H !(MAXRES,MAXRES) + real(kind=8),dimension(:),allocatable :: XX !(MAXRES) +! COMMON /frozen/ + integer,dimension(:),allocatable :: mask !(maxres) +! COMMON /store0/ + integer :: nhpb0 +!----------------------------------------------------------------------------- +! common.thread +! common /thread/ + integer :: nthread,nexcl + integer,dimension(:,:),allocatable :: iexam,ipatt !(2,maxthread) +! common /thread1/ + real(kind=8),dimension(:,:),allocatable :: ener0,ener !(n_ene+2,maxthread) + real(kind=8) :: max_time_for_thread,ave_time_for_thread +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module compare_data diff --git a/source/unres/data/control_data.f90 b/source/unres/data/control_data.f90 new file mode 100644 index 0000000..6ec06d0 --- /dev/null +++ b/source/unres/data/control_data.f90 @@ -0,0 +1,92 @@ + module control_data +!----------------------------------------------------------------------------- +! Max. number of types of dihedral angles & multiplicity of torsional barriers +! and the number of terms in double torsionals + integer,parameter :: maxtor=4,maxterm=10,maxlor=3 + integer,parameter :: maxtermd_1=8,maxtermd_2=8 +!----------------------------------------------------------------------------- +! Max. number of groups of interactions that a given SC is involved in + integer,parameter :: maxint_gr=2 +!----------------------------------------------------------------------------- +! Max. number of residue types and parameters in expressions for +! virtual-bond angle bending potentials + integer,parameter :: maxthetyp=3,maxthetyp1=maxthetyp+1 + integer,parameter :: maxtheterm=20 + integer,parameter :: maxtheterm2=6,maxtheterm3=4 + integer,parameter :: maxsingle=6,maxdouble=4 + integer,parameter :: mmaxtheterm=maxtheterm +!----------------------------------------------------------------------------- +! Max number of torsional terms in SCCOR + integer,parameter :: maxterm_sccor=7000 +!----------------------------------------------------------------------------- +! Max. number of lobes in SC distribution +! integer,parameter :: maxlob=4 in geometry +!----------------------------------------------------------------------------- +! Max. number of S-S bridges + integer,parameter :: maxss=20 +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! commom.control +! common /cntrl/ + integer :: modecalc,iscode,indpdb,indback,indphi,iranconf,& + icheckgrad,iprint,i2ndstr,mucadyn,constr_dist,symetr + logical :: minim,refstr,pdbref,overlapsc,& + energy_dec,sideadd,lsecondary,read_cart,unres_pdb,& + vdisulf,searchsc,lmuca,dccart,extconf,out1file,& + gnorm_check,gradout,split_ene +#ifdef CLUSTER + integer :: iopt,nend,nstart,outpdb,outmol2 !cluster + logical :: punch_dist,print_dist,lside,lprint_cart,lprint_int,& + caonly,efree,from_bx,from_cx,from_cart ! cluster +#else + logical :: outpdb,outmol2 +#endif +!... minim = .true. means DO minimization. +!... energy_dec = .true. means print energy decomposition matrix +!----------------------------------------------------------------------------- +! common.header +! common /header/ + character(len=80) :: titel +!----------------------------------------------------------------------------- +! common.spitele +! common /splitele/ + real(kind=8) :: r_cut,rlamb +!----------------------------------------------------------------------------- +! common.time1 +! FOUND_NAN - set by calcf to stop sumsl via stopx +! COMMON/TIME1/ + real(kind=8) :: TIMLIM,SAFETY,WALLTIME +! common /timing/ + real(kind=8) :: t_eelecij,t_enegrad,t_MDsetup,t_langsetup,t_MD,& + t_sdsetup,time_stoch,time_fric,time_fsample,time_sumene,& + time_enecalc,time_vec,time_bcast,time_reduce,time_gather,& + time_sendrecv,time_barrier_e,time_barrier_g,time_scatter,& + time_ginvmult,time_bcast7,time_bcastc,time_bcastw,& + time_allreduce,& + time_lagrangian,time_cartgrad,& + time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart,& + time_mat,time_fricmatmult,& + time_scatter_fmat,time_scatter_ginv,& + time_scatter_fmatmult,time_scatter_ginvmult,& + t_eshort,t_elong,t_etotal +#if defined(WHAM_RUN) || defined(CLUSTER) +! common /stoptim/ +!el integer :: WhatsUp,ndelta + integer :: ndelta + logical :: cutoffviol,cutoffeval,llocal +! common /timing/ wham +! Timers and counters for the respective routines + real(kind=8) :: t_func,t_grad,t_fhel,t_fbet,t_ghel,t_gbet,& + t_viol,t_gviol,t_map,t_alamap,t_betamap + integer :: n_func,n_grad,n_fhel,n_fbet,n_ghel,n_gbet,n_viol,& + n_gviol,n_map,n_alamap,n_betamap +#endif +!----------------------------------------------------------------------------- + integer,parameter :: MaxMoveType = 4 +!----------------------------------------------------------------------------- +! Max. number of processors. + integer,parameter :: maxprocs=2048 +!el integer,parameter :: maxprocs=4200 +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module control_data diff --git a/source/unres/data/energy_data.f90 b/source/unres/data/energy_data.f90 new file mode 100644 index 0000000..11382e2 --- /dev/null +++ b/source/unres/data/energy_data.f90 @@ -0,0 +1,278 @@ + module energy_data +!----------------------------------------------------------------------------- + use names +!----------------------------------------------------------------------------- +! Max. number of energy intervals + integer,parameter :: max_ene=21 !10 +!----------------------------------------------------------------------------- +! Maximum number of terms in SC bond-stretching potential + integer,parameter :: maxbondterm=3 +!----------------------------------------------------------------------------- +! Max. number of derivatives of virtual-bond and side-chain vectors in theta +! or phi. + integer :: maxdim +!----------------------------------------------------------------------------- +! Max. number of contacts per residue + integer :: maxconts +!----------------------------------------------------------------------------- +! Max. number of SC contacts + integer :: maxcont +!----------------------------------------------------------------------------- +! commom.contacts +! common /contacts/ + integer :: ncont,ncont_ref + integer,dimension(:,:),allocatable :: icont,icont_ref !(2,maxcont) +!#ifdef WHAM_RUN +! integer,dimension(:),allocatable :: nsccont_frag_ref !(mmaxfrag) !wham +! integer,dimension(:,:,:),allocatable :: isccont_frag_ref !(2,maxcont,mmaxfrag) !wham +!#endif +! 12/13/2008 (again Poland-Jaruzel war anniversary) +! RE: Parallelization of 4th and higher order loc-el correlations +! common /contdistrib/ + integer,dimension(:),allocatable :: iat_sent !(maxres) +! iat_sent - zainicjowane w initialize_p.F; + integer,dimension(:,:,:),allocatable :: iint_sent,iint_sent_local !(4,maxres,maxres) + integer,dimension(:,:),allocatable :: iturn3_sent,iturn4_sent,& + iturn3_sent_local,iturn4_sent_local !(4,maxres), + integer,dimension(:),allocatable :: itask_cont_from,itask_cont_to !(0:max_fg_procs-1), + integer :: nat_sent,ntask_cont_from,ntask_cont_to +!----------------------------------------------------------------------------- +! commom.deriv; +! common /derivat/ + real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim) + real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres) + real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2) + real(kind=8),dimension(:,:),allocatable :: gvdwx !(3,maxres) + real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2) ,gloc_x !!! nie używane + real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres) + real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres) + integer :: nfl,icg + +! common /derivat/ wham + logical :: calc_grad +! common /mpgrad/ + integer :: igrad_start,igrad_end + integer,dimension(:),allocatable :: jgrad_start,jgrad_end !(maxres) +!----------------------------------------------------------------------------- +! The following COMMON block selects the type of the force field used in +! calculations and defines weights of various energy terms. +! 12/1/95 wcorr added +!----------------------------------------------------------------------------- +! common.ffield +! common /ffield/ + integer :: n_ene_comp + integer :: rescale_mode + real(kind=8) :: wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang,& + wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,& + wturn6,wvdwpp +#ifdef CLUSTER + real(kind=8) :: scalscp +#endif + real(kind=8),dimension(:),allocatable :: weights !(n_ene) + real(kind=8) :: temp0,scal14,cutoff_corr,delt_corr,r0_corr + integer :: ipot +! common /potentials/ + character(len=3),dimension(5) :: potname = & + (/'LJ ','LJK','BP ','GB ','GBV'/) +!----------------------------------------------------------------------------- +! wlong,welec,wtor,wang,wscloc are the weight of the energy terms +! corresponding to side-chain, electrostatic, torsional, valence-angle, +! and local side-chain terms. +! +! IPOT determines which SC...SC interaction potential will be used: +! 1 - LJ: 2n-n Lennard-Jones +! 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) +! 3 - BP; Berne-Pechukas (angular dependence) +! 4 - GB; Gay-Berne (angular dependence) +! 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential +!----------------------------------------------------------------------------- +! common.interact +! common /interact/ + real(kind=8),dimension(:,:),allocatable :: aa,bb,augm !(ntyp,ntyp) + real(kind=8),dimension(:,:),allocatable :: aad,bad !(ntyp,2) + real(kind=8),dimension(2,2) :: app,bpp,ael6,ael3 + integer :: expon,expon2, nnt,nct,itypro + integer,dimension(:,:),allocatable :: istart,iend !(maxres,maxint_gr) + integer,dimension(:),allocatable :: nint_gr,itype,itel,& + ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr !(maxres) + integer,dimension(:,:),allocatable :: iscpstart,iscpend !(maxres,maxint_gr) + integer :: iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,& + iatel_e_vdw,iatscp_s,iatscp_e,ispp,iscp +! 12/1/95 Array EPS included in the COMMON block. +! common /body/ + real(kind=8),dimension(:,:),allocatable :: sigma !(0:ntyp1,0:ntyp1) + real(kind=8),dimension(:,:),allocatable :: eps,sigmaii,& + rs0,chi,r0,r0e !(ntyp,ntyp) r0e !!! nie używane + real(kind=8),dimension(:),allocatable :: chip,alp,sigma0,& + sigii,rr0 !(ntyp) + real(kind=8),dimension(2,2) :: rpp,epp,elpp6,elpp3 + real(kind=8),dimension(:,:),allocatable :: r0d,eps_scp,rscp !(ntyp,2) r0d !!! nie używane +! 12/5/03 modified 09/18/03 Bond stretching parameters. +! common /stretch/ + real(kind=8) :: vbldp0,akp,distchainmax + real(kind=8),dimension(:,:),allocatable :: vbldsc0,aksc,abond0 !(maxbondterm,ntyp) + integer,dimension(:),allocatable :: nbondterm !(ntyp) +!----------------------------------------------------------------------------- +! common.local +! Parameters of ab initio-derived potential of virtual-bond-angle bending +! common /theta_abinitio/ + integer :: nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,& + ndouble,nntheterm + integer,dimension(:),allocatable :: ithetyp !(-ntyp1:ntyp1) + real(kind=8),dimension(:,:,:,:),allocatable :: aa0thet +!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + real(kind=8),dimension(:,:,:,:,:),allocatable :: aathet + real(kind=8),dimension(:,:,:,:,:,:),allocatable :: bbthet,& + ccthet,ddthet,eethet +!(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: ffthet,ggthet +!(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) +! Parameters of the virtual-bond-angle probability distribution +! common /thetas/ + real(kind=8),dimension(:),allocatable :: a0thet,theta0,& + sig0,sigc0 !(-ntyp:ntyp) + real(kind=8),dimension(:,:,:,:),allocatable :: athet,bthet !(2,-ntyp:ntyp,-1:1,-1:1) + real(kind=8),dimension(:,:),allocatable :: polthet !(0:3,-ntyp:ntyp) + real(kind=8),dimension(:,:),allocatable :: gthet !(3,-ntyp:ntyp) +! Parameters of the side-chain probability distribution +! common /sclocal/ + real(kind=8),dimension(:),allocatable :: dsc,dsc_inv,dsc0 !(ntyp1) + real(kind=8),dimension(:,:),allocatable :: bsc !(maxlob,ntyp) + real(kind=8),dimension(:,:,:),allocatable :: censc !(3,maxlob,-ntyp:ntyp) + real(kind=8),dimension(:,:,:,:),allocatable :: gaussc !(3,3,maxlob,-ntyp:ntyp) + integer,dimension(:),allocatable :: nlob !(ntyp1) +! Virtual-bond lenghts +! common /peptbond/ + real(kind=8) :: vbl,vblinv,vblinv2,vbl_cis,vbl0 +! common /indices/ + 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 + integer,dimension(:),allocatable :: ibond_displ,ibond_count,& + ithet_displ,ithet_count,iphi_displ,iphi_count,iphi1_displ,& + iphi1_count,ivec_displ,ivec_count,iset_displ,iset_count,& + iint_count,iint_displ !(0:max_fg_procs-1) +!----------------------------------------------------------------------------- +! common.MD +! common /mdgrad/ + real(kind=8),dimension(:,:),allocatable :: gcart,gxcart !(3,0:MAXRES) + real(kind=8),dimension(:,:),allocatable :: gradcag,gradxag !(3,MAXRES) !!! nie używane +! common /back_constr/ + integer :: nfrag_back + real(kind=8) :: uconst_back + real(kind=8),dimension(:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back) + real(kind=8),dimension(:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20) + integer,dimension(:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20) +! common /qmeas/ + real(kind=8),dimension(50) :: qfrag + real(kind=8),dimension(100) :: qpair + real(kind=8),dimension(:,:),allocatable :: qinfrag,wfrag !(50,maxprocs/20) + real(kind=8),dimension(:,:),allocatable :: qinpair,wpair !(100,maxprocs/20) + real(kind=8) :: eq_time,Uconst + integer :: iset,nset + integer,dimension(:),allocatable :: mset !(maxprocs/20) + integer,dimension(:,:,:),allocatable :: ifrag !(2,50,maxprocs/20) + integer,dimension(:,:,:),allocatable :: ipair !(2,100,maxprocs/20) + integer :: nfrag,npair + logical :: usampl +!----------------------------------------------------------------------------- +! common.sbridge +! common /sbridge/ + real(kind=8) :: ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + integer :: ns,nss,nfree + integer,dimension(:),allocatable :: iss !(maxss) +! common /links/ + real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane + integer :: nhpb + integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane +! common /restraints/ + real(kind=8) :: weidis +! common /links_split/ + integer :: link_start,link_end +! common /dyn_ssbond/ + real(kind=8) :: Ht + integer,dimension(:),allocatable :: idssb,jdssb !(maxdim) + logical :: dyn_ss + logical,dimension(:),allocatable :: dyn_ss_mask !(maxres) +!----------------------------------------------------------------------------- +! common.sccor +! Parameters of the SCCOR term +! common/sccor/ + real(kind=8),dimension(:,:,:,:),allocatable :: v1sccor,v2sccor !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp) + real(kind=8),dimension(:,:,:),allocatable :: v0sccor !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp) + integer :: nsccortyp + integer,dimension(:),allocatable :: isccortyp !(-ntyp:ntyp) + integer,dimension(:,:),allocatable :: nterm_sccor,nlor_sccor !(-ntyp:ntyp,-ntyp:ntyp) + real(kind=8),dimension(:,:,:),allocatable :: vlor1sccor,& + vlor2sccor,vlor3sccor !(maxterm_sccor,20,20) + real(kind=8),dimension(:,:,:),allocatable :: gloc_sc !(3,0:maxres2,10) + real(kind=8),dimension(:,:,:,:),allocatable :: dtauangle !(3,3,3,maxres2) +!----------------------------------------------------------------------------- +! common.scrot +! Parameters of the SC rotamers (local) term +! common/scrot/ + real(kind=8),dimension(:,:),allocatable :: sc_parmin !(maxsccoef,ntyp) +!----------------------------------------------------------------------------- +! common.torcnstr +! common /torcnstr/ + integer :: ndih_constr,ndih_nconstr + integer,dimension(:),allocatable :: idih_constr,idih_nconstr !(maxdih_constr) + integer :: idihconstr_start,idihconstr_end + real(kind=8) :: ftors + real(kind=8),dimension(:),allocatable :: drange !(maxdih_constr) + real(kind=8),dimension(:),allocatable :: phi0 !(maxdih_constr) +!----------------------------------------------------------------------------- +! common.torsion +! Torsional constants of the rotation about virtual-bond dihedral angles +! common/torsion/ + real(kind=8),dimension(:,:,:),allocatable :: v0 !(-maxtor:maxtor,-maxtor:maxtor,2) +#ifdef CRYST_TOR + real(kind=8),dimension(:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor) +#else + real(kind=8),dimension(:,:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) +#endif + real(kind=8),dimension(:,:,:),allocatable :: vlor1 !(maxlor,-maxtor:maxtor,-maxtor:maxtor) + real(kind=8),dimension(:,:,:),allocatable :: vlor2,vlor3 !(maxlor,maxtor,maxtor) + integer,dimension(:),allocatable :: itortyp !(-ntyp1:ntyp1) + integer,dimension(:,:,:),allocatable :: nterm,nlor !(-maxtor:maxtor,-maxtor:maxtor,2) + integer :: ntortyp,nterm_old +! 6/23/01 - constants for double torsionals +! common /torsiond/ + real(kind=8),dimension(:,:,:,:,:,:),allocatable :: v1c,v1s + !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) + real(kind=8),dimension(:,:,:,:,:,:),allocatable :: v2c,v2s + !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) + integer,dimension(:,:,:,:),allocatable :: ntermd_1,ntermd_2 + !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) +! 9/18/99 - added Fourier coeffficients of the expansion of local energy +! surfacecommon +! common/fourier/ + real(kind=8),dimension(:,:),allocatable :: b1,b2,& + b1tilde !(2,-maxtor:maxtor), + real(kind=8),dimension(:,:,:),allocatable :: cc,dd,ee,& + ctilde,dtilde !(2,2,-maxtor:maxtor) + integer :: nloctyp +! common/fourier/ z wham + real(kind=8),dimension(:,:),allocatable :: b !(13,0:maxtor) +!----------------------------------------------------------------------------- +! common.var +! Store the geometric variables in the following COMMON block. +! common /var/ in module geometry_data +! Store the angles and variables corresponding to old conformations (for use +! in MCM). +! common /oldgeo/ +!el real(kind=8),dimension(:,:),allocatable :: varsave !(maxvar,maxsave) +! real(kind=8),dimension(:),allocatable :: esave !(maxsave) +! integer,dimension(:),allocatable :: Origin !(maxsave) +! integer :: nstore +! freeze some variables +! common /restr/ + real(kind=8),dimension(:),allocatable :: varall !(maxvar) + integer,dimension(:),allocatable :: mask_theta,& + mask_phi,mask_side !(maxres) + logical :: mask_r +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module energy_data diff --git a/source/unres/data/geometry_data.f90 b/source/unres/data/geometry_data.f90 new file mode 100644 index 0000000..e6e73d2 --- /dev/null +++ b/source/unres/data/geometry_data.f90 @@ -0,0 +1,60 @@ + module geometry_data +!----------------------------------------------------------------------------- +! commom.bounds +! common /bounds/ + real(kind=8),dimension(:,:),allocatable :: phibound !(2,maxres) +!----------------------------------------------------------------------------- +! commom.chain +! common /chain/ + real(kind=8),dimension(:,:),allocatable :: c !(3,maxres2+2) + real(kind=8),dimension(:,:),allocatable :: dc,dc_old,& + dc_norm,dc_norm2 !(3,0:maxres2) + real(kind=8),dimension(:,:),allocatable :: xloc,xrot !(3,maxres) + real(kind=8),dimension(:),allocatable :: dc_work !(MAXRES6) + integer :: nres,nres0 +! common /rotmat/ + real(kind=8),dimension(:,:,:),allocatable :: prod,rt !(3,3,maxres) +! common /refstruct/ + real(kind=8),dimension(:,:,:),allocatable :: cref !(3,maxres2+2,maxperm), + real(kind=8),dimension(:,:),allocatable :: crefjlee !(3,maxres2+2), + real(kind=8),dimension(:,:,:),allocatable :: chain_rep !(3,maxres2+2,maxsym) + integer :: nsup,nstart_sup,nstart_seq,chain_length,iprzes,nperm + integer :: nend_sup,ishift_pdb !wham + real(kind=8) :: rmssing,anatemp !wham + integer,dimension(:,:),allocatable :: tabperm !(maxperm,maxsym) +! common /from_zscore/ in module.compare +!----------------------------------------------------------------------------- +! common.geo +! common /geo/ + real(kind=8) :: pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin +!----------------------------------------------------------------------------- +! common.local +! Inverses of the actual virtual bond lengths +! common /invlen/ + real(kind=8),dimension(:),allocatable :: vbld_inv !(maxres2) +!----------------------------------------------------------------------------- +! Max. number of lobes in SC distribution + integer,parameter :: maxlob=5 +!----------------------------------------------------------------------------- +! Max number of symetric chains + integer,parameter :: maxsym=50 + integer,parameter :: maxperm=120 +!----------------------------------------------------------------------------- +! common.var +! Store the geometric variables in the following COMMON block. +! common /var/ + real(kind=8),dimension(:),allocatable :: theta,phi,alph,omeg,& + thetaref,phiref,costtab,sinttab,cost2tab,sint2tab !(maxres) + real(kind=8),dimension(:),allocatable :: vbld !(2*maxres) + real(kind=8),dimension(:,:),allocatable :: omicron !(2,maxres) + real(kind=8),dimension(:,:),allocatable :: tauangle !(3,maxres) + real(kind=8),dimension(:),allocatable :: xxtab,yytab,zztab,& + xxref,yyref,zzref !(maxres) + integer,dimension(:,:),allocatable :: ialph !(maxres,2) + integer,dimension(:),allocatable :: ivar !(4*maxres2) + integer :: ntheta,nphi,nside,nvar +!----------------------------------------------------------------------------- + integer,dimension(:),allocatable :: itype_pdb !(maxres) initialize in molread +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module geometry_data diff --git a/source/unres/data/io_units.f90 b/source/unres/data/io_units.f90 new file mode 100644 index 0000000..e470892 --- /dev/null +++ b/source/unres/data/io_units.f90 @@ -0,0 +1,71 @@ + module io_units +!----------------------------------------------------------------------- +! common.iounits +! I/O units used by the program +!----------------------------------------------------------------------- +! 9/18/99 - unit ifourier and filename fouriername included to identify +! the file from which the coefficients of second-order Fourier expansion +! of the local-interaction energy are read. +! 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) +! included. +!----------------------------------------------------------------------- +! General I/O units & files +! common /iounits/ + 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 +#ifdef WHAM_RUN +! el wham iounits + integer :: isidep1,ihist,iweight,izsc,idistr +#endif +#ifdef CLUSTER +! el cluster iounits + integer :: jrms,jplot +#endif +! +! common /fnames/ + character(len=256) :: outname,intname,pdbname,mol2name,statname,& + intinname,entname,prefix,secpred,rest2name,qname,cartname,& + tmpdir,mremd_rst_name,curdir,pref_orig +#ifdef CLUSTER + integer :: isidep1 + character(len=256) :: rmsname,prefintin,prefout +#endif +!#ifdef WHAM_RUN +! el wham iounits + character(len=256) :: restartnam,scratchdir,sidepname,pdbfile,& + histname,zscname + character(len=4) :: liczba + character(len=3) :: pot +!#endif +! Parameter files +! common /parfiles/ + character(len=256) :: bondname,thetname,rotname,torname,tordname,& + fouriername,elename,sidename,scpname,sccorname,patname,& + thetname_pdb,rotname_pdb +!----------------------------------------------------------------------- +! INP - main input file +! IOUT - list file +! IGEOM - geometry output in the form of virtual-chain internal coordinates +! INTIN - geometry input (for multiple conformation processing) in int. coords. +! IPDB - Cartesian-coordinate output in PDB format +! IMOL2 - Cartesian-coordinate output in Tripos mol2 format +! IPDBIN - PDB input file +! ITHEP - virtual-bond torsional angle parametrs +! IROTAM - side-chain geometry and local-interaction parameters +! ITORP - torsional parameters +! ITORDP - double torsional parameters +! IFOURIER - coefficients of the expansion of local-interaction energy +! IELEP - electrostatic-interaction parameters +! ISIDEP - side-chain interaction parameters. +! ISCPP - SCp interaction parameters. +! IBOND - virtual-bond constant parameters and moments of inertia. +! ISCCOR - parameters of the potential of SCCOR term +! ICBASE - data base with Cartesian coords of known structures. +! ISTAT - energies and other conf. characteristics from an MCM run. +! IENTIN - entropy from preceeding simulation(s) to be read in. +! SECPRED - SECONDARY STRUCTURE PREDICTION for dihedral constraint generation. +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module io_units diff --git a/source/unres/data/map_data.f90 b/source/unres/data/map_data.f90 new file mode 100644 index 0000000..b706d35 --- /dev/null +++ b/source/unres/data/map_data.f90 @@ -0,0 +1,10 @@ + module map_data +!----------------------------------------------------------------------------- +! commom.map +! common /mapp/ + integer :: nmap + integer,dimension(:),allocatable :: kang,res1,res2,nstep !(maxvar) + real(kind=8),dimension(:),allocatable :: ang_from,ang_to !(maxvar) +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module map_data diff --git a/source/unres/data/minim_data.f90 b/source/unres/data/minim_data.f90 new file mode 100644 index 0000000..cfa788d --- /dev/null +++ b/source/unres/data/minim_data.f90 @@ -0,0 +1,13 @@ + module minim_data +!----------------------------------------------------------------------------- +! commom.minim +! common /minimm/ + real(kind=8) :: tolf,rtolf + integer :: maxfun,maxmin,minfun,minmin,& + print_min_ini,print_min_stat,print_min_res +!----------------------------------------------------------------------------- +! common /przechowalnia/ subroutines: minim_jlee,minimize,minim_dc, +! minim_mcmf,minimize_sc1 + real(kind=8),dimension(:),allocatable :: v !77+maxvar*(maxvar+17)/2 (maxvar=6*maxres) +!----------------------------------------------------------------------------- + end module minim_data diff --git a/source/unres/data/names.f90 b/source/unres/data/names.f90 new file mode 100644 index 0000000..d5a23a2 --- /dev/null +++ b/source/unres/data/names.f90 @@ -0,0 +1,66 @@ + module names +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! Number of AA types (at present only natural AA's will be handled + integer,parameter :: ntyp=24,ntyp1=ntyp+1 +!----------------------------------------------------------------------------- +! common.names +! common /names/ +!el character(len=3),dimension(:),allocatable :: restyp !(-ntyp1:ntyp1) +!el character(len=1),dimension(:),allocatable :: onelet !(-ntyp1:ntyp1) +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! block data nazwy +!el allocate(restyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1) + character(len=3),dimension(-ntyp1:ntyp1) :: 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','SME','DBZ',& + 'AIB','ABU','D '/) +!el allocate(onelet(-ntyp1:ntyp1)) !(-ntyp1:ntyp1) + character(len=1),dimension(-ntyp1:ntyp1) :: 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','z','z','z','z','X'/) +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +! Number of energy components + integer,parameter :: n_ene=21 + integer :: n_ene2=2*n_ene +!----------------------------------------------------------------------------- +! common.names +!#ifndef WHAM_RUN +! common /namterm/ +! character(len=10),dimension(n_ene) :: 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 "/) +! character(len=10),dimension(n_ene) :: wname = & +! (/"WSC ","WSCP ","WELEC ","WCORR ","WCORR5 ","WCORR6 ","WEL_LOC ",& +! "WTURN3 ","WTURN4 ","WTURN6 ","WANG ","WSCLOC ","WTOR ","WTORD ",& +! "WSTRAIN ","WVDWPP ","WBOND ","SCAL14 "," "," ","WSCCOR "/) +! integer :: nprint_ene = 20 +! integer,dimension(n_ene) :: print_order = & +! (/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,21,0/) +!#else + character(len=10),dimension(n_ene) :: 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 "/) + character(len=10),dimension(n_ene) :: wname = & + (/"WSC ","WSCP ","WELEC" ,"WCORR ","WCORR5 ","WCORR6 ","WEL_LOC ",& + "WTURN3 ","WTURN4 ","WTURN6 ","WANG ","WSCLOC ","WTOR ","WTORD ",& + "WHPB ","WVDWPP ","WSCP14 ","WBOND ","WSCCOR ","WDIHC ","WSC "/) + + integer :: nprint_ene = 21 + integer,dimension(n_ene) :: print_order = & + (/1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19,16,15,17,20,21/) +!#endif +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module names diff --git a/source/unres/energy.f90 b/source/unres/energy.f90 index 59b09b7..e25c098 100644 --- a/source/unres/energy.f90 +++ b/source/unres/energy.f90 @@ -11,15 +11,27 @@ ! implicit none !----------------------------------------------------------------------------- +! Max. number of contacts per residue +! integer :: maxconts +!----------------------------------------------------------------------------- +! Max. number of derivatives of virtual-bond and side-chain vectors in theta +! or phi. +! integer :: maxdim +!----------------------------------------------------------------------------- +! Max. number of SC contacts +! integer :: maxcont +!----------------------------------------------------------------------------- ! Max. number of variables integer :: maxvar !----------------------------------------------------------------------------- -! Max number of torsional terms in SCCOR - integer,parameter :: maxterm_sccor=6 +! Max number of torsional terms in SCCOR in control_data +! integer,parameter :: maxterm_sccor=6 !----------------------------------------------------------------------------- ! Maximum number of SC local term fitting function coefficiants integer,parameter :: maxsccoef=65 !----------------------------------------------------------------------------- +! commom.calc common/calc/ +!----------------------------------------------------------------------------- ! commom.contacts ! common /contacts/ ! Change 12/1/95 - common block CONTACTS1 included. @@ -274,29 +286,48 @@ ! ! Compute the side-chain and electrostatic interaction energy ! - goto (101,102,103,104,105,106) ipot +! goto (101,102,103,104,105,106) ipot + select case(ipot) ! Lennard-Jones potential. - 101 call elj(evdw) +! 101 call elj(evdw) + case (1) + call elj(evdw) !d print '(a)','Exit ELJcall el' - goto 107 +! goto 107 ! Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw) - goto 107 +! 102 call eljk(evdw) + case (2) + call eljk(evdw) +! goto 107 ! Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw) - goto 107 +! 103 call ebp(evdw) + case (3) + call ebp(evdw) +! goto 107 ! Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw) - goto 107 +! 104 call egb(evdw) + case (4) + call egb(evdw) +! goto 107 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw) - goto 107 +! 105 call egbv(evdw) + case (5) + call egbv(evdw) +! goto 107 ! Soft-sphere potential - 106 call e_softsphere(evdw) +! 106 call e_softsphere(evdw) + case (6) + call e_softsphere(evdw) ! ! Calculate electrostatic (H-bonding) energy of the main chain. ! - 107 continue +! 107 continue + case default + write(iout,*)"Wrong ipot" +! return +! 50 continue + end select +! continue !mc !mc Sep-06: egb takes care of dynamic ss bonds too @@ -324,6 +355,7 @@ .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then #endif call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) +! write (iout,*) "ELEC calc" else ees=0.0d0 evdw1=0.0d0 @@ -341,6 +373,7 @@ ! Calculate excluded-volume interaction energy between peptide groups ! and side chains. ! +!elwrite(iout,*) "in etotal calc exc;luded",ipot if (ipot.lt.6) then if(wscp.gt.0d0) then @@ -353,16 +386,20 @@ ! write (iout,*) "Soft-sphere SCP potential" call escp_soft_sphere(evdw2,evdw2_14) endif +!elwrite(iout,*) "in etotal before ebond",ipot ! ! Calculate the bond-stretching energy ! call ebond(estr) +!elwrite(iout,*) "in etotal afer ebond",ipot + ! ! Calculate the disulfide-bridge and other energy and the contributions ! from other distance constraints. - print *,'Calling EHPB' +! print *,'Calling EHPB' call edis(ehpb) +!elwrite(iout,*) "in etotal afer edis",ipot ! print *,'EHPB exitted succesfully.' ! ! Calculate the virtual-bond-angle energy. @@ -377,6 +414,7 @@ ! Calculate the SC local energy. ! call esc(escloc) +!elwrite(iout,*) "in etotal afer esc",ipot ! print *,"Processor",myrank," computed USC" ! ! Calculate the virtual-bond torsional energy. @@ -392,6 +430,7 @@ ! ! 6/23/01 Calculate double-torsional energy ! +!elwrite(iout,*) "in etotal",ipot if (wtor_d.gt.0) then call etor_d(etors_d) else @@ -423,22 +462,28 @@ ecorr6=0.0d0 eturn6=0.0d0 endif +!elwrite(iout,*) "in etotal",ipot 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) !d write (iout,*) "multibody_hb ecorr",ecorr endif +!elwrite(iout,*) "afeter multibody hb" ! print *,"Processor",myrank," computed Ucorr" ! ! If performing constraint dynamics, call the constraint energy ! after the equilibration time if(usampl.and.totT.gt.eq_time) then +!elwrite(iout,*) "afeter multibody hb" call EconstrQ +!elwrite(iout,*) "afeter multibody hb" call Econstr_back +!elwrite(iout,*) "afeter multibody hb" else Uconst=0.0d0 Uconst_back=0.0d0 endif +!elwrite(iout,*) "after Econstr" #ifdef TIMING time_enecalc=time_enecalc+MPI_Wtime()-time00 @@ -490,6 +535,8 @@ #ifdef TIMING time_sumene=time_sumene+MPI_Wtime()-time00 #endif +!el call enerprint(energia) +!elwrite(iout,*)"finish etotal" return end subroutine etotal !----------------------------------------------------------------------------- @@ -525,7 +572,7 @@ integer :: ierr real(kind=8) :: time00 if (nfgtasks.gt.1 .and. reduce) then -!el #define DEBUG + #ifdef DEBUG write (iout,*) "energies before REDUCE" call enerprint(energia) @@ -614,7 +661,7 @@ #ifdef MPI endif #endif -!el #undef DUBUG +! call enerprint(energia) call flush(iout) return end subroutine sum_energy @@ -631,33 +678,56 @@ real(kind=8) :: kfac=2.4d0 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644 !el local variables - real(kind=8) :: t_bath,facT,facT2,facT3,facT4,facT5 + real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6 + real(kind=8) :: T0=3.0d2 integer :: ierror ! facT=temp0/t_bath ! 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 + facT(1)=1.0d0 + facT(2)=1.0d0 + facT(3)=1.0d0 + facT(4)=1.0d0 + facT(5)=1.0d0 + facT(6)=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) + facT(1)=kfac/(kfac-1.0d0+t_bath/temp0) + facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) + facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) + facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) + facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) +#ifdef WHAM_RUN +!#if defined(WHAM_RUN) || defined(CLUSTER) +#if defined(FUNCTH) +! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3) + facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 +#elif defined(FUNCT) + facT(6)=t_bath/T0 +#else + facT(6)=1.0d0 +#endif +#endif 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)) + facT(1)=licznik/dlog(dexp(x)+dexp(-x)) + facT(2)=licznik/dlog(dexp(x2)+dexp(-x2)) + facT(3)=licznik/dlog(dexp(x3)+dexp(-x3)) + facT(4)=licznik/dlog(dexp(x4)+dexp(-x4)) + facT(5)=licznik/dlog(dexp(x5)+dexp(-x5)) +#ifdef WHAM_RUN +!#if defined(WHAM_RUN) || defined(CLUSTER) +#if defined(FUNCTH) + facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 +#elif defined(FUNCT) + facT(6)=t_bath/T0 +#else + facT(6)=1.0d0 +#endif +#endif else write (iout,*) "Wrong RESCALE_MODE",rescale_mode write (*,*) "Wrong RESCALE_MODE",rescale_mode @@ -666,17 +736,17 @@ #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 + welec=weights(3)*fact(1) + wcorr=weights(4)*fact(3) + wcorr5=weights(5)*fact(4) + wcorr6=weights(6)*fact(5) + wel_loc=weights(7)*fact(2) + wturn3=weights(8)*fact(2) + wturn4=weights(9)*fact(3) + wturn6=weights(10)*fact(5) + wtor=weights(13)*fact(1) + wtor_d=weights(14)*fact(2) + wsccor=weights(21)*fact(1) return end subroutine rescale_weights @@ -1202,7 +1272,7 @@ integer :: iint,itypi,itypi1,itypj real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi real(kind=8) :: evdw,sig0ij - + integer :: ii !cccc energy_dec=.false. ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 @@ -1233,14 +1303,16 @@ evdw=evdw+evdwij if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & 'evdw',i,j,evdwij,' ss' +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,' ss' ELSE !el ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) -! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -! & 1.0d0/vbld(j+nres) +! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,& +! 1.0d0/vbld(j+nres) !d ! write (iout,*) "i",i," j", j," itype",itype(i),itype(j) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) @@ -1269,8 +1341,12 @@ dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -! write (iout,*) "j",j," dc_norm", -! & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) +! write (iout,*) "j",j," dc_norm",& !d +! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) +! write(iout,*)"rrij ",rrij +! write(iout,*)"xj yj zj ", xj, yj, zj +! write(iout,*)"xi yi zi ", xi, yi, zi +! write(iout,*)"c ", c(1,:), c(2,:), c(3,:) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) ! Calculate angle-dependent terms of energy and contributions to their @@ -1279,6 +1355,8 @@ sigsq=1.0D0/sigsq sig=sig0ij*dsqrt(sigsq) rij_shift=1.0D0/rij-sig+sig0ij +! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,& +! "sig0ij",sig0ij ! for diagnostics; uncomment ! rij_shift=1.2*sig0ij ! I hate to put IF's in the loops, but here don't have another choice!!!! @@ -1298,8 +1376,9 @@ evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt -! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& -! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 +! write(iout,*)"aa, bb ",aa(:,:),bb(:,:) +! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d +! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij if (lprn) then @@ -1314,7 +1393,9 @@ endif if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & - 'evdw',i,j,evdwij + 'evdw',i,j,evdwij !,"egb" +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij ! Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -1952,56 +2033,11 @@ integer :: i,iti1,iti,k,l real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2 -! allocate(Ug(2,2,nres)) !(2,2,maxres) -! allocate(Ug2(2,2,nres)) !(2,2,maxres) -! allocate(Ugder(2,2,nres)) !(2,2,maxres) -! allocate(Ug2der(2,2,nres)) !(2,2,maxres) -! allocate(obrot(2,nres)) !(2,maxres) -! allocate(obrot2(2,nres)) !(2,maxres) -! allocate(obrot_der(2,nres)) !(2,maxres) -! allocate(obrot2_der(2,nres)) !(2,maxres) -! allocate(costab2(nres)) !(maxres) -! allocate(sintab2(nres)) !(maxres) -! allocate(costab(nres)) !(maxres) -! allocate(sintab(nres)) !(maxres) - -! allocate(Ub2(2,nres)) !(2,maxres) -! allocate(Ctobr(2,nres)) !(2,maxres) -! allocate(Dtobr2(2,nres)) !(2,maxres) -! allocate(mu(2,nres)) !(2,maxres) -! allocate(muder(2,nres)) !(2,maxres) -! allocate(Ub2der(2,nres)) !(2,maxres) -! allocate(Ctobrder(2,nres)) !(2,maxres) -! allocate(Dtobr2der(2,nres)) !(2,maxres) - -! allocate(EUg(2,2,nres)) !(2,2,maxres) -! allocate(CUg(2,2,nres)) !(2,2,maxres) -! allocate(DUg(2,2,nres)) !(2,2,maxres) -! allocate(DtUg2(2,2,nres)) !(2,2,maxres) -! allocate(EUgder(2,2,nres)) !(2,2,maxres) -! allocate(CUgder(2,2,nres)) !(2,2,maxres) -! allocate(DUgder(2,2,nres)) !(2,2,maxres) -! allocate(Dtug2der(2,2,nres)) !(2,2,maxres) - -! allocate(Ug2Db1t(2,nres)) !(2,maxres) -! allocate(Ug2Db1tder(2,nres)) !(2,maxres) -! allocate(CUgb2(2,nres)) !(2,maxres) -! allocate(CUgb2der(2,nres)) !(2,maxres) - -! allocate(EUgC(2,2,nres)) !(2,2,maxres) -! allocate(EUgCder(2,2,nres)) !(2,2,maxres) -! allocate(EUgD(2,2,nres)) !(2,2,maxres) -! allocate(EUgDder(2,2,nres)) !(2,2,maxres) -! allocate(DtUg2EUg(2,2,nres)) !(2,2,maxres) -! allocate(Ug2DtEUg(2,2,nres)) !(2,2,maxres) - -! allocate(Ug2DtEUgder(2,2,2,nres)) !(2,2,2,maxres) -! allocate(DtUg2EUgder(2,2,2,nres)) !(2,2,2,maxres) - ! ! Compute the virtual-bond-torsional-angle dependent quantities needed ! to calculate the el-loc multibody terms of various order. ! +!AL el mu=0.0d0 #ifdef PARMAT do i=ivec_start+2,ivec_end+2 #else @@ -2132,7 +2168,9 @@ do k=1,2 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) enddo -!d write (iout,*) 'mu ',mu(:,i-2) +! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2) +! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1) +! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2) !d write (iout,*) 'mu1',mu1(:,i-2) !d write (iout,*) 'mu2',mu2(:,i-2) if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) & @@ -2171,7 +2209,6 @@ enddo endif #if defined(MPI) && defined(PARMAT) -!el #define DUBUG #ifdef DEBUG ! if (fg_rank.eq.0) then write (iout,*) "Arrays UG and UGDER before GATHER" @@ -2428,7 +2465,6 @@ !d enddo !d enddo return -!el #undef DUBUG end subroutine set_matrices !----------------------------------------------------------------------------- subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) @@ -2500,7 +2536,26 @@ !d enddo !d call check_vecgrad !d stop +! ees=0.0d0 !AS +! evdw1=0.0d0 +! eel_loc=0.0d0 +! eello_turn3=0.0d0 +! eello_turn4=0.0d0 + t_eelecij=0.0d0 + ees=0.0D0 + evdw1=0.0D0 + eel_loc=0.0d0 + eello_turn3=0.0d0 + eello_turn4=0.0d0 +! + if (icheckgrad.eq.1) then +!el +! do i=0,2*nres+2 +! dc_norm(1,i)=0.0d0 +! dc_norm(2,i)=0.0d0 +! dc_norm(3,i)=0.0d0 +! enddo do i=1,nres-1 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) do k=1,3 @@ -3068,10 +3123,12 @@ ! 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) -!d write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij +! 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 (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33 +! if (energy_dec) write (iout,*) "muij",muij ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) eel_loc=eel_loc+eel_loc_ij @@ -3125,6 +3182,7 @@ r0ij=2.20D0*rpp(iteli,itelj) ! r0ij=1.55D0*rpp(iteli,itelj) call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) +!elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts if (fcont.gt.0.0D0) then num_conti=num_conti+1 if (num_conti.gt.maxconts) then @@ -4188,7 +4246,7 @@ if (i.gt.3 .and. itype(i-2).ne.ntyp1) then #ifdef OSF - phii=phi(i) + phii=phi(i) if (phii.ne.phii) phii=150.0 #else phii=phi(i) @@ -4201,7 +4259,7 @@ endif if (i.lt.nres .and. itype(i).ne.ntyp1) then #ifdef OSF - phii1=phi(i+1) + phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 phii1=pinorm(phii1) z(1)=cos(phii1) @@ -4917,7 +4975,6 @@ sumene1x,sumene2x,sumene3x,sumene4x,& sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,& cosfac2xx,sinfac2yy -!el #define DEBUG #ifdef DEBUG real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,& de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,& @@ -5144,7 +5201,6 @@ #ifdef DEBUG write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i) #endif -!#undef DEBUG ! ! cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) @@ -5219,7 +5275,6 @@ 1 continue enddo -!el #undef DUBUG return end subroutine esc !----------------------------------------------------------------------------- @@ -5375,8 +5430,8 @@ etors_ii=0.0D0 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)) + itori=itortyp(itype(i-2)) + itori1=itortyp(itype(i-1)) phii=phi(i) gloci=0.0D0 ! Proline-Proline pair is a special case... @@ -5672,6 +5727,7 @@ esccor_ii=0.0D0 isccori=isccortyp(itype(i-2)) isccori1=isccortyp(itype(i-1)) + ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1) phii=phi(i) do intertyp=1,3 !intertyp @@ -10199,17 +10255,13 @@ icall=0 call geom_to_var(nvar,x) if (.not.split_ene) then -write(iout,*) 'Calling CHECK_ECARTINT if' call etotal(energia) -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' etot=energia(0) !el call enerprint(energia) -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' call flush(iout) write (iout,*) "enter cartgrad" call flush(iout) call cartgrad -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' write (iout,*) "exit cartgrad" call flush(iout) icall =1 @@ -10219,7 +10271,6 @@ write(iout,*) 'Calling CHECK_ECARTINT if' do j=1,3 grad_s(j,0)=gcart(j,0) enddo -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' do i=1,nres do j=1,3 grad_s(j,i)=gcart(j,i) @@ -10227,7 +10278,6 @@ write(iout,*) 'Calling CHECK_ECARTINT if' enddo enddo else -write(iout,*) 'Calling CHECK_ECARTIN else.' !- split gradient check call zerograd call etotal_long(energia) @@ -10421,14 +10471,12 @@ write(iout,*) 'Calling CHECK_ECARTIN else.' call zerograd aincr=1.0D-7 print '(a)','Calling CHECK_INT.' -write(iout,*) 'Calling CHECK_INT.' nf=0 nfl=0 icg=1 call geom_to_var(nvar,x) call var_to_geom(nvar,x) call chainbuild -write(iout,*) 'Calling CHECK_INT.' icall=1 print *,'ICG=',ICG call etotal(energia) @@ -10447,7 +10495,7 @@ write(iout,*) 'Calling CHECK_INT.' nfl=3 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar) call gradient(nvar,x,nf,gana,uiparm,urparm,fdum) - write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp +!d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp icall=1 do i=1,nvar xi=x(i) @@ -10485,7 +10533,6 @@ write(iout,*) 'Calling CHECK_INT.' i,key,ii,gg(i),gana(i),& 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr) enddo -write(iout,*) "jestesmy sobie w check eint!!" return end subroutine check_eint !----------------------------------------------------------------------------- @@ -11325,6 +11372,8 @@ write(iout,*) "jestesmy sobie w check eint!!" if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'evdw',i,j,evdwij +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,"egb_long" ! Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -11468,6 +11517,8 @@ write(iout,*) "jestesmy sobie w check eint!!" if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'evdw',i,j,evdwij +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,"egb_short" ! Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -12398,11 +12449,11 @@ write(iout,*) "jestesmy sobie w check eint!!" ! 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) -!d write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij +! 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 -! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) +! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d eel_loc=eel_loc+eel_loc_ij ! Partial derivatives in virtual-bond dihedral angles gamma @@ -13708,7 +13759,9 @@ write(iout,*) "jestesmy sobie w check eint!!" call sum_gradient #ifdef TIMING #endif +!el write (iout,*) "After sum_gradient" #ifdef DEBUG +!el write (iout,*) "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) @@ -13729,10 +13782,12 @@ write(iout,*) "jestesmy sobie w check eint!!" gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) enddo endif +!elwrite (iout,*) "After sum_gradient" #ifdef TIMING time01=MPI_Wtime() #endif call intcartderiv +!elwrite (iout,*) "After sum_gradient" #ifdef TIMING time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 #endif @@ -14089,11 +14144,6 @@ write(iout,*) "jestesmy sobie w check eint!!" endif enddo !alculate 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 @@ -14112,7 +14162,10 @@ write(iout,*) "jestesmy sobie w check eint!!" cost=dcos(theta(i)) cost1=dcos(omicron(2,i-1)) cosg=dcos(tauangle(1,i)) +!elwrite(iout,*) " vecpr5",i,nres do j=1,3 +!elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres +!elwrite(iout,*) " vecpr5",dc_norm2(1,1) dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" enddo @@ -15027,7 +15080,7 @@ write(iout,*) "jestesmy sobie w check eint!!" integer :: kstart,kend,lstart,lend,idummy real(kind=8) :: delta=1.0d-7 !el local variables - integer :: i,ii,j + integer :: i,ii,j ! real(kind=8) :: ! For the backbone do i=0,nres-1 @@ -15273,6 +15326,7 @@ write(iout,*) "jestesmy sobie w check eint!!" real(kind=8) :: deps,ssx0,ljx0 !-------END TESTING CODE + eij=0.0d0 i=resi j=resj @@ -15532,31 +15586,31 @@ write(iout,*) "jestesmy sobie w check eint!!" endif if (havebond) then -#ifndef CLUST -#ifndef WHAM +!#ifndef CLUST +!#ifndef WHAM ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then ! write(iout,'(a15,f12.2,f8.1,2i5)') ! & "SSBOND_E_FORM",totT,t_bath,i,j ! endif -#endif -#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 +!#ifndef CLUST +!#ifndef WHAM ! write(iout,'(a15,f12.2,f8.1,2i5)') ! & "SSBOND_E_BREAK",totT,t_bath,i,j -#endif -#endif +!#endif +!#endif endif !-------TESTING CODE - if (checkstop) then +!el if (checkstop) then if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') & "CHECKSTOP",rij,eij,ed echeck(jcheck)=eij - endif +!el endif enddo if (checkstop) then write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps @@ -15649,11 +15703,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.CHAIN' ! include 'COMMON.IOUNITS' ! include 'COMMON.SETUP' -#ifndef CLUST -#ifndef WHAM ! include 'COMMON.MD' -#endif -#endif ! Local variables real(kind=8) :: emin integer :: i,j,imin,ierr @@ -15788,7 +15838,7 @@ write(iout,*) "jestesmy sobie w check eint!!" !----------------------------------------------------------------------------- #ifdef WHAM subroutine read_ssHist - implicit none +! implicit none ! Includes ! include 'DIMENSIONS' ! include "DIMENSIONS.FREE" @@ -15844,28 +15894,42 @@ write(iout,*) "jestesmy sobie w check eint!!" maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond !---------------------- ! arrays in subroutine init_int_table +!el#ifdef MPI +!el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1) +!el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1) +!el#endif allocate(nint_gr(nres)) allocate(nscp_gr(nres)) allocate(ielstart(nres)) - allocate(ielend(nres)) !(maxres) + allocate(ielend(nres)) +!(maxres) allocate(istart(nres,maxint_gr)) - allocate(iend(nres,maxint_gr)) !(maxres,maxint_gr) + allocate(iend(nres,maxint_gr)) +!(maxres,maxint_gr) allocate(iscpstart(nres,maxint_gr)) - allocate(iscpend(nres,maxint_gr)) !(maxres,maxint_gr) + allocate(iscpend(nres,maxint_gr)) +!(maxres,maxint_gr) allocate(ielstart_vdw(nres)) - allocate(ielend_vdw(nres)) !(maxres) + allocate(ielend_vdw(nres)) +!(maxres) - allocate(lentyp(0:nfgtasks-1)) !(0:maxprocs-1) + allocate(lentyp(0:nfgtasks-1)) +!(0:maxprocs-1) !---------------------- ! commom.contacts ! common /contacts/ if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont)) - allocate(icont(2,maxcont)) !(2,maxcont) + allocate(icont(2,maxcont)) +!(2,maxcont) ! common /contacts1/ - allocate(num_cont(0:nres+4)) !(maxres) - allocate(jcont(maxconts,nres)) !(maxconts,maxres) - allocate(facont(maxconts,nres)) !(maxconts,maxres) - allocate(gacont(3,maxconts,nres)) !(3,maxconts,maxres) + allocate(num_cont(0:nres+4)) +!(maxres) + allocate(jcont(maxconts,nres)) +!(maxconts,maxres) + allocate(facont(maxconts,nres)) +!(maxconts,maxres) + allocate(gacont(3,maxconts,nres)) +!(3,maxconts,maxres) ! common /contacts_hb/ allocate(gacontp_hb1(3,maxconts,nres)) allocate(gacontp_hb2(3,maxconts,nres)) @@ -15874,31 +15938,42 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(gacontm_hb2(3,maxconts,nres)) allocate(gacontm_hb3(3,maxconts,nres)) allocate(gacont_hbr(3,maxconts,nres)) - allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) + allocate(grij_hb_cont(3,maxconts,nres)) +!(3,maxconts,maxres) allocate(facont_hb(maxconts,nres)) allocate(ees0p(maxconts,nres)) allocate(ees0m(maxconts,nres)) - allocate(d_cont(maxconts,nres)) !(maxconts,maxres) - allocate(num_cont_hb(nres)) !(maxres) - allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres) + allocate(d_cont(maxconts,nres)) +!(maxconts,maxres) + allocate(num_cont_hb(nres)) +!(maxres) + allocate(jcont_hb(maxconts,nres)) +!(maxconts,maxres) ! common /rotat/ allocate(Ug(2,2,nres)) allocate(Ugder(2,2,nres)) allocate(Ug2(2,2,nres)) - allocate(Ug2der(2,2,nres)) !(2,2,maxres) + allocate(Ug2der(2,2,nres)) +!(2,2,maxres) allocate(obrot(2,nres)) allocate(obrot2(2,nres)) allocate(obrot_der(2,nres)) - allocate(obrot2_der(2,nres)) !(2,maxres) + allocate(obrot2_der(2,nres)) +!(2,maxres) ! common /precomp1/ allocate(mu(2,nres)) allocate(muder(2,nres)) allocate(Ub2(2,nres)) + do i=1,nres + Ub2(1,i)=0.0d0 + Ub2(2,i)=0.0d0 + enddo allocate(Ub2der(2,nres)) allocate(Ctobr(2,nres)) allocate(Ctobrder(2,nres)) allocate(Dtobr2(2,nres)) - allocate(Dtobr2der(2,nres)) !(2,maxres) + allocate(Dtobr2der(2,nres)) +!(2,maxres) allocate(EUg(2,2,nres)) allocate(EUgder(2,2,nres)) allocate(CUg(2,2,nres)) @@ -15906,25 +15981,30 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(DUg(2,2,nres)) allocate(Dugder(2,2,nres)) allocate(DtUg2(2,2,nres)) - allocate(DtUg2der(2,2,nres)) !(2,2,maxres) + allocate(DtUg2der(2,2,nres)) +!(2,2,maxres) ! common /precomp2/ allocate(Ug2Db1t(2,nres)) allocate(Ug2Db1tder(2,nres)) allocate(CUgb2(2,nres)) - allocate(CUgb2der(2,nres)) !(2,maxres) + allocate(CUgb2der(2,nres)) +!(2,maxres) allocate(EUgC(2,2,nres)) allocate(EUgCder(2,2,nres)) allocate(EUgD(2,2,nres)) allocate(EUgDder(2,2,nres)) allocate(DtUg2EUg(2,2,nres)) - allocate(Ug2DtEUg(2,2,nres)) !(2,2,maxres) + allocate(Ug2DtEUg(2,2,nres)) +!(2,2,maxres) allocate(Ug2DtEUgder(2,2,2,nres)) - allocate(DtUg2EUgder(2,2,2,nres)) !(2,2,2,maxres) + allocate(DtUg2EUgder(2,2,2,nres)) +!(2,2,2,maxres) ! common /rotat_old/ allocate(costab(nres)) allocate(sintab(nres)) allocate(costab2(nres)) - allocate(sintab2(nres)) !(maxres) + allocate(sintab2(nres)) +!(maxres) ! common /dipmat/ allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)(maxconts=maxres/4) @@ -15934,24 +16014,33 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(ncont_sent(nres)) allocate(ncont_recv(nres)) - allocate(iat_sent(nres)) !(maxres) + allocate(iat_sent(nres)) +!(maxres) allocate(iint_sent(4,nres,nres)) - allocate(iint_sent_local(4,nres,nres)) !(4,maxres,maxres) + allocate(iint_sent_local(4,nres,nres)) +!(4,maxres,maxres) allocate(iturn3_sent(4,0:nres+4)) allocate(iturn4_sent(4,0:nres+4)) allocate(iturn3_sent_local(4,nres)) - allocate(iturn4_sent_local(4,nres)) !(4,maxres) + allocate(iturn4_sent_local(4,nres)) +!(4,maxres) allocate(itask_cont_from(0:nfgtasks-1)) - allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1) + allocate(itask_cont_to(0:nfgtasks-1)) +!(0:max_fg_procs-1) + + !---------------------- ! commom.deriv; ! common /derivat/ allocate(dcdv(6,maxdim)) - allocate(dxdv(6,maxdim)) !(6,maxdim) - allocate(dxds(6,nres)) !(6,maxres) + allocate(dxdv(6,maxdim)) +!(6,maxdim) + allocate(dxds(6,nres)) +!(6,maxres) allocate(gradx(3,nres,0:2)) - allocate(gradc(3,nres,0:2)) !(3,maxres,2) + allocate(gradc(3,nres,0:2)) +!(3,maxres,2) allocate(gvdwx(3,nres)) allocate(gvdwc(3,nres)) allocate(gelc(3,nres)) @@ -15969,32 +16058,41 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(gcorr6_turn_long(3,nres)) allocate(gradxorr(3,nres)) allocate(gradcorr5(3,nres)) - allocate(gradcorr6(3,nres)) !(3,maxres) + allocate(gradcorr6(3,nres)) +!(3,maxres) allocate(gloc(0:maxvar,0:2)) - allocate(gloc_x(0:maxvar,2)) !(maxvar,2) + allocate(gloc_x(0:maxvar,2)) +!(maxvar,2) allocate(gel_loc(3,nres)) allocate(gel_loc_long(3,nres)) allocate(gcorr3_turn(3,nres)) allocate(gcorr4_turn(3,nres)) allocate(gcorr6_turn(3,nres)) allocate(gradb(3,nres)) - allocate(gradbx(3,nres)) !(3,maxres) + allocate(gradbx(3,nres)) +!(3,maxres) allocate(gel_loc_loc(maxvar)) allocate(gel_loc_turn3(maxvar)) allocate(gel_loc_turn4(maxvar)) allocate(gel_loc_turn6(maxvar)) allocate(gcorr_loc(maxvar)) allocate(g_corr5_loc(maxvar)) - allocate(g_corr6_loc(maxvar)) !(maxvar) + allocate(g_corr6_loc(maxvar)) +!(maxvar) allocate(gsccorc(3,nres)) - allocate(gsccorx(3,nres)) !(3,maxres) - allocate(gsccor_loc(nres)) !(maxres) - allocate(dtheta(3,2,nres)) !(3,2,maxres) + allocate(gsccorx(3,nres)) +!(3,maxres) + allocate(gsccor_loc(nres)) +!(maxres) + allocate(dtheta(3,2,nres)) +!(3,2,maxres) allocate(gscloc(3,nres)) - allocate(gsclocx(3,nres)) !(3,maxres) + allocate(gsclocx(3,nres)) +!(3,maxres) allocate(dphi(3,3,nres)) allocate(dalpha(3,3,nres)) - allocate(domega(3,3,nres)) !(3,3,maxres) + allocate(domega(3,3,nres)) +!(3,3,maxres) ! common /deriv_scloc/ allocate(dXX_C1tab(3,nres)) allocate(dYY_C1tab(3,nres)) @@ -16004,10 +16102,13 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(dZZ_Ctab(3,nres)) allocate(dXX_XYZtab(3,nres)) allocate(dYY_XYZtab(3,nres)) - allocate(dZZ_XYZtab(3,nres)) !(3,maxres) + allocate(dZZ_XYZtab(3,nres)) +!(3,maxres) ! common /mpgrad/ allocate(jgrad_start(nres)) - allocate(jgrad_end(nres)) !(maxres) + allocate(jgrad_end(nres)) +!(maxres) +!---------------------- ! common /indices/ allocate(ibond_displ(0:nfgtasks-1)) @@ -16023,20 +16124,25 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(iset_displ(0:nfgtasks-1)) allocate(iset_count(0:nfgtasks-1)) allocate(iint_count(0:nfgtasks-1)) - allocate(iint_displ(0:nfgtasks-1)) !(0:max_fg_procs-1) + allocate(iint_displ(0:nfgtasks-1)) +!(0:max_fg_procs-1) !---------------------- ! common.MD ! common /mdgrad/ allocate(gcart(3,0:nres)) - allocate(gxcart(3,0:nres)) !(3,0:MAXRES) + allocate(gxcart(3,0:nres)) +!(3,0:MAXRES) allocate(gradcag(3,nres)) - allocate(gradxag(3,nres)) !(3,MAXRES) + allocate(gradxag(3,nres)) +!(3,MAXRES) ! common /back_constr/ !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back) allocate(dutheta(nres)) - allocate(dugamma(nres)) !(maxres) + allocate(dugamma(nres)) +!(maxres) allocate(duscdiff(3,nres)) - allocate(duscdiffx(3,nres)) !(3,maxres) + allocate(duscdiffx(3,nres)) +!(3,maxres) !el i io:read_fragments ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20) ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20) @@ -16052,7 +16158,8 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(dUdconst(3,0:nres)) allocate(dUdxconst(3,0:nres)) allocate(dqwol(3,0:nres)) - allocate(dxqwol(3,0:nres)) !(3,0:MAXRES) + allocate(dxqwol(3,0:nres)) +!(3,0:MAXRES) !---------------------- ! common.sbridge ! common /sbridge/ in io_common: read_bridge @@ -16062,7 +16169,8 @@ write(iout,*) "jestesmy sobie w check eint!!" !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane ! common /dyn_ssbond/ ! and side-chain vectors in theta or phi. - allocate(dyn_ssbond_ij(0:nres+4,0:nres+4)) !(maxres,maxres) + allocate(dyn_ssbond_ij(0:nres+4,0:nres+4)) +!(maxres,maxres) do i=1,nres do j=i+1,nres dyn_ssbond_ij(i,j)=1.0d300 @@ -16070,9 +16178,11 @@ write(iout,*) "jestesmy sobie w check eint!!" enddo if (nss.gt.0) then - allocate(idssb(nss),jdssb(nss)) !(maxdim) + allocate(idssb(nss),jdssb(nss)) +!(maxdim) endif - allocate(dyn_ss_mask(nres)) !(maxres) + allocate(dyn_ss_mask(nres)) +!(maxres) do i=1,nres dyn_ss_mask(i)=.false. enddo @@ -16091,59 +16201,32 @@ write(iout,*) "jestesmy sobie w check eint!!" ! allocate(vlor2sccor(maxterm_sccor,20,20)) ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20) !---------------- - allocate(gloc_sc(3,0:2*nres,0:10)) !(3,0:maxres2,10)maxres2=2*maxres + allocate(gloc_sc(3,0:2*nres,0:10)) +!(3,0:maxres2,10)maxres2=2*maxres allocate(dcostau(3,3,3,2*nres)) allocate(dsintau(3,3,3,2*nres)) allocate(dtauangle(3,3,3,2*nres)) allocate(dcosomicron(3,3,3,2*nres)) - allocate(domicron(3,3,3,2*nres)) !(3,3,3,maxres2)maxres2=2*maxres -!---------------------- -! common.scrot -! Parameters of the SC rotamers (local) term -! common/scrot/ in io_conf: parmread -! allocate((:,:),allocatable :: sc_parmin !(maxsccoef,ntyp) -!---------------------- -! common.torcnstr -! common /torcnstr/ -!el in io_conf:molread -! allocate((:),allocatable :: idih_constr,idih_nconstr !(maxdih_constr) -! allocate((:),allocatable :: phi0,drange !(maxdih_constr) -!---------------------- -! common.torsion -! common/torsion/ in io_conf: parmread -! allocate((:,:,:),allocatable :: v0 !(-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:),allocatable :: vlor1 !(maxlor,-maxtor:maxtor,-maxtor:maxtor) -! allocate((:,:,:),allocatable :: vlor2,vlor3 !(maxlor,maxtor,maxtor) -! allocate((:),allocatable :: itortyp !(-ntyp1:ntyp1) -! allocate((:,:,:),allocatable :: nterm,nlor !(-maxtor:maxtor,-maxtor:maxtor,2) -! -! common /torsiond/ in io_conf: parmread -! allocate((:,:,:,:,:,:),allocatable :: v1c,v1s - !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:,:,:,:),allocatable :: v2c,v2s - !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:,:),allocatable :: ntermd_1,ntermd_2 - !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! common/fourier/ in io_conf: parmread -! allocate((:,:),allocatable :: b1,b2,& -! b1tilde !(2,-maxtor:maxtor) -! allocate((:,:,:),allocatable :: cc,dd,ee,& -! ctilde,dtilde !(2,2,-maxtor:maxtor) + allocate(domicron(3,3,3,2*nres)) +!(3,3,3,maxres2)maxres2=2*maxres !---------------------- ! common.var ! common /restr/ - allocate(varall(maxvar)) !(maxvar)(maxvar=6*maxres) + allocate(varall(maxvar)) +!(maxvar)(maxvar=6*maxres) allocate(mask_theta(nres)) allocate(mask_phi(nres)) - allocate(mask_side(nres)) !(maxres) + allocate(mask_side(nres)) +!(maxres) !---------------------- ! common.vectors ! common /vectors/ allocate(uy(3,nres)) - allocate(uz(3,nres)) !(3,maxres) + allocate(uz(3,nres)) +!(3,maxres) allocate(uygrad(3,3,2,nres)) - allocate(uzgrad(3,3,2,nres)) !(3,3,2,maxres) + allocate(uzgrad(3,3,2,nres)) +!(3,3,2,maxres) return end subroutine alloc_ener_arrays diff --git a/source/unres/energy_data.f90 b/source/unres/energy_data.f90 deleted file mode 100644 index 39f7d20..0000000 --- a/source/unres/energy_data.f90 +++ /dev/null @@ -1,275 +0,0 @@ - module energy_data -!----------------------------------------------------------------------------- - use names -!----------------------------------------------------------------------------- -! Max. number of energy intervals - integer,parameter :: max_ene=10 -!----------------------------------------------------------------------------- -! Maximum number of terms in SC bond-stretching potential - integer,parameter :: maxbondterm=3 -!----------------------------------------------------------------------------- -! Max. number of derivatives of virtual-bond and side-chain vectors in theta -! or phi. - integer :: maxdim -!----------------------------------------------------------------------------- -! Max. number of contacts per residue - integer :: maxconts -!----------------------------------------------------------------------------- -! Max. number of SC contacts - integer :: maxcont -!----------------------------------------------------------------------------- -! commom.contacts -! common /contacts/ - integer :: ncont,ncont_ref - integer,dimension(:,:),allocatable :: icont,icont_ref !(2,maxcont) -#ifdef WHAM_RUN - integer,dimension(:),allocatable :: nsccont_frag_ref !(mmaxfrag) !wham - integer,dimension(:,:,:),allocatable :: isccont_frag_ref !(2,maxcont,mmaxfrag) !wham -#endif -! 12/13/2008 (again Poland-Jaruzel war anniversary) -! RE: Parallelization of 4th and higher order loc-el correlations -! common /contdistrib/ - integer,dimension(:),allocatable :: iat_sent !(maxres) -! iat_sent - zainicjowane w initialize_p.F; - integer,dimension(:,:,:),allocatable :: iint_sent,iint_sent_local !(4,maxres,maxres) - integer,dimension(:,:),allocatable :: iturn3_sent,iturn4_sent,& - iturn3_sent_local,iturn4_sent_local !(4,maxres), - integer,dimension(:),allocatable :: itask_cont_from,itask_cont_to !(0:max_fg_procs-1), - integer :: nat_sent,ntask_cont_from,ntask_cont_to -!----------------------------------------------------------------------------- -! commom.deriv; -! common /derivat/ - real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim) - real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres) - real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2) - real(kind=8),dimension(:,:),allocatable :: gvdwx !(3,maxres) - real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2) ,gloc_x !!! nie używane - real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres) - real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres) - integer :: nfl,icg - -! common /derivat/ wham - logical :: calc_grad -! common /mpgrad/ - integer :: igrad_start,igrad_end - integer,dimension(:),allocatable :: jgrad_start,jgrad_end !(maxres) -!----------------------------------------------------------------------------- -! The following COMMON block selects the type of the force field used in -! calculations and defines weights of various energy terms. -! 12/1/95 wcorr added -!----------------------------------------------------------------------------- -! common.ffield -! common /ffield/ - integer :: n_ene_comp - integer :: rescale_mode - real(kind=8) :: wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang,& - wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,& - wturn6,wvdwpp - real(kind=8),dimension(:),allocatable :: weights !(n_ene) - real(kind=8) :: temp0,scal14,cutoff_corr,delt_corr,r0_corr - integer :: ipot -! common /potentials/ - character(len=3),dimension(5) :: potname = & - (/'LJ ','LJK','BP ','GB ','GBV'/) -!----------------------------------------------------------------------------- -! wlong,welec,wtor,wang,wscloc are the weight of the energy terms -! corresponding to side-chain, electrostatic, torsional, valence-angle, -! and local side-chain terms. -! -! IPOT determines which SC...SC interaction potential will be used: -! 1 - LJ: 2n-n Lennard-Jones -! 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) -! 3 - BP; Berne-Pechukas (angular dependence) -! 4 - GB; Gay-Berne (angular dependence) -! 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential -!----------------------------------------------------------------------------- -! common.interact -! common /interact/ - real(kind=8),dimension(:,:),allocatable :: aa,bb,augm !(ntyp,ntyp) - real(kind=8),dimension(:,:),allocatable :: aad,bad !(ntyp,2) - real(kind=8),dimension(2,2) :: app,bpp,ael6,ael3 - integer :: expon,expon2, nnt,nct,itypro - integer,dimension(:,:),allocatable :: istart,iend !(maxres,maxint_gr) - integer,dimension(:),allocatable :: nint_gr,itype,itel,& - ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr !(maxres) - integer,dimension(:,:),allocatable :: iscpstart,iscpend !(maxres,maxint_gr) - integer :: iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,& - iatel_e_vdw,iatscp_s,iatscp_e,ispp,iscp -! 12/1/95 Array EPS included in the COMMON block. -! common /body/ - real(kind=8),dimension(:,:),allocatable :: sigma !(0:ntyp1,0:ntyp1) - real(kind=8),dimension(:,:),allocatable :: eps,sigmaii,& - rs0,chi,r0,r0e !(ntyp,ntyp) r0e !!! nie używane - real(kind=8),dimension(:),allocatable :: chip,alp,sigma0,& - sigii,rr0 !(ntyp) - real(kind=8),dimension(2,2) :: rpp,epp,elpp6,elpp3 - real(kind=8),dimension(:,:),allocatable :: r0d,eps_scp,rscp !(ntyp,2) r0d !!! nie używane -! 12/5/03 modified 09/18/03 Bond stretching parameters. -! common /stretch/ - real(kind=8) :: vbldp0,akp,distchainmax - real(kind=8),dimension(:,:),allocatable :: vbldsc0,aksc,abond0 !(maxbondterm,ntyp) - integer,dimension(:),allocatable :: nbondterm !(ntyp) -!----------------------------------------------------------------------------- -! common.local -! Parameters of ab initio-derived potential of virtual-bond-angle bending -! common /theta_abinitio/ - integer :: nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,& - ndouble,nntheterm - integer,dimension(:),allocatable :: ithetyp !(-ntyp1:ntyp1) - real(kind=8),dimension(:,:,:,:),allocatable :: aa0thet -!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) - real(kind=8),dimension(:,:,:,:,:),allocatable :: aathet - real(kind=8),dimension(:,:,:,:,:,:),allocatable :: bbthet,& - ccthet,ddthet,eethet -!(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) - real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: ffthet,ggthet -!(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) -! Parameters of the virtual-bond-angle probability distribution -! common /thetas/ - real(kind=8),dimension(:),allocatable :: a0thet,theta0,& - sig0,sigc0 !(-ntyp:ntyp) - real(kind=8),dimension(:,:,:,:),allocatable :: athet,bthet !(2,-ntyp:ntyp,-1:1,-1:1) - real(kind=8),dimension(:,:),allocatable :: polthet !(0:3,-ntyp:ntyp) - real(kind=8),dimension(:,:),allocatable :: gthet !(3,-ntyp:ntyp) -! Parameters of the side-chain probability distribution -! common /sclocal/ - real(kind=8),dimension(:),allocatable :: dsc,dsc_inv,dsc0 !(ntyp1) - real(kind=8),dimension(:,:),allocatable :: bsc !(maxlob,ntyp) - real(kind=8),dimension(:,:,:),allocatable :: censc !(3,maxlob,-ntyp:ntyp) - real(kind=8),dimension(:,:,:,:),allocatable :: gaussc !(3,3,maxlob,-ntyp:ntyp) - integer,dimension(:),allocatable :: nlob !(ntyp1) -! Virtual-bond lenghts -! common /peptbond/ - real(kind=8) :: vbl,vblinv,vblinv2,vbl_cis,vbl0 -! common /indices/ - 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 - integer,dimension(:),allocatable :: ibond_displ,ibond_count,& - ithet_displ,ithet_count,iphi_displ,iphi_count,iphi1_displ,& - iphi1_count,ivec_displ,ivec_count,iset_displ,iset_count,& - iint_count,iint_displ !(0:max_fg_procs-1) -!----------------------------------------------------------------------------- -! common.MD -! common /mdgrad/ - real(kind=8),dimension(:,:),allocatable :: gcart,gxcart !(3,0:MAXRES) - real(kind=8),dimension(:,:),allocatable :: gradcag,gradxag !(3,MAXRES) !!! nie używane -! common /back_constr/ - integer :: nfrag_back - real(kind=8) :: uconst_back - real(kind=8),dimension(:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back) - real(kind=8),dimension(:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20) - integer,dimension(:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20) -! common /qmeas/ - real(kind=8),dimension(50) :: qfrag - real(kind=8),dimension(100) :: qpair - real(kind=8),dimension(:,:),allocatable :: qinfrag,wfrag !(50,maxprocs/20) - real(kind=8),dimension(:,:),allocatable :: qinpair,wpair !(100,maxprocs/20) - real(kind=8) :: eq_time,Uconst - integer :: iset,nset - integer,dimension(:),allocatable :: mset !(maxprocs/20) - integer,dimension(:,:,:),allocatable :: ifrag !(2,50,maxprocs/20) - integer,dimension(:,:,:),allocatable :: ipair !(2,100,maxprocs/20) - integer :: nfrag,npair - logical :: usampl -!----------------------------------------------------------------------------- -! common.sbridge -! common /sbridge/ - real(kind=8) :: ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer :: ns,nss,nfree - integer,dimension(:),allocatable :: iss !(maxss) -! common /links/ - real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane - integer :: nhpb - integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane -! common /restraints/ - real(kind=8) :: weidis -! common /links_split/ - integer :: link_start,link_end -! common /dyn_ssbond/ - real(kind=8) :: Ht - integer,dimension(:),allocatable :: idssb,jdssb !(maxdim) - logical :: dyn_ss - logical,dimension(:),allocatable :: dyn_ss_mask !(maxres) -!----------------------------------------------------------------------------- -! common.sccor -! Parameters of the SCCOR term -! common/sccor/ - real(kind=8),dimension(:,:,:,:),allocatable :: v1sccor,v2sccor !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp) - real(kind=8),dimension(:,:,:),allocatable :: v0sccor !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp) - integer :: nsccortyp - integer,dimension(:),allocatable :: isccortyp !(-ntyp:ntyp) - integer,dimension(:,:),allocatable :: nterm_sccor,nlor_sccor !(-ntyp:ntyp,-ntyp:ntyp) - real(kind=8),dimension(:,:,:),allocatable :: vlor1sccor,& - vlor2sccor,vlor3sccor !(maxterm_sccor,20,20) - real(kind=8),dimension(:,:,:),allocatable :: gloc_sc !(3,0:maxres2,10) - real(kind=8),dimension(:,:,:,:),allocatable :: dtauangle !(3,3,3,maxres2) -!----------------------------------------------------------------------------- -! common.scrot -! Parameters of the SC rotamers (local) term -! common/scrot/ - real(kind=8),dimension(:,:),allocatable :: sc_parmin !(maxsccoef,ntyp) -!----------------------------------------------------------------------------- -! common.torcnstr -! common /torcnstr/ - integer :: ndih_constr,ndih_nconstr - integer,dimension(:),allocatable :: idih_constr,idih_nconstr !(maxdih_constr) - integer :: idihconstr_start,idihconstr_end - real(kind=8) :: ftors - real(kind=8),dimension(:),allocatable :: drange !(maxdih_constr) - real(kind=8),dimension(:),allocatable :: phi0 !(maxdih_constr) -!----------------------------------------------------------------------------- -! common.torsion -! Torsional constants of the rotation about virtual-bond dihedral angles -! common/torsion/ - real(kind=8),dimension(:,:,:),allocatable :: v0 !(-maxtor:maxtor,-maxtor:maxtor,2) -#ifdef CRYST_TOR - real(kind=8),dimension(:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor) -#else - real(kind=8),dimension(:,:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) -#endif - real(kind=8),dimension(:,:,:),allocatable :: vlor1 !(maxlor,-maxtor:maxtor,-maxtor:maxtor) - real(kind=8),dimension(:,:,:),allocatable :: vlor2,vlor3 !(maxlor,maxtor,maxtor) - integer,dimension(:),allocatable :: itortyp !(-ntyp1:ntyp1) - integer,dimension(:,:,:),allocatable :: nterm,nlor !(-maxtor:maxtor,-maxtor:maxtor,2) - integer :: ntortyp,nterm_old -! 6/23/01 - constants for double torsionals -! common /torsiond/ - real(kind=8),dimension(:,:,:,:,:,:),allocatable :: v1c,v1s - !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) - real(kind=8),dimension(:,:,:,:,:,:),allocatable :: v2c,v2s - !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) - integer,dimension(:,:,:,:),allocatable :: ntermd_1,ntermd_2 - !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! 9/18/99 - added Fourier coeffficients of the expansion of local energy -! surfacecommon -! common/fourier/ - real(kind=8),dimension(:,:),allocatable :: b1,b2,& - b1tilde !(2,-maxtor:maxtor), - real(kind=8),dimension(:,:,:),allocatable :: cc,dd,ee,& - ctilde,dtilde !(2,2,-maxtor:maxtor) - integer :: nloctyp -! common/fourier/ z wham - real(kind=8),dimension(:,:),allocatable :: b !(13,0:maxtor) -!----------------------------------------------------------------------------- -! common.var -! Store the geometric variables in the following COMMON block. -! common /var/ in module geometry_data -! Store the angles and variables corresponding to old conformations (for use -! in MCM). -! common /oldgeo/ -!el real(kind=8),dimension(:,:),allocatable :: varsave !(maxvar,maxsave) -! real(kind=8),dimension(:),allocatable :: esave !(maxsave) -! integer,dimension(:),allocatable :: Origin !(maxsave) -! integer :: nstore -! freeze some variables -! common /restr/ - real(kind=8),dimension(:),allocatable :: varall !(maxvar) - integer,dimension(:),allocatable :: mask_theta,& - mask_phi,mask_side !(maxres) - logical :: mask_r -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module energy_data diff --git a/source/unres/geometry.f90 b/source/unres/geometry.f90 index 780684e..8b30374 100644 --- a/source/unres/geometry.f90 +++ b/source/unres/geometry.f90 @@ -9,6 +9,9 @@ use energy_data implicit none !----------------------------------------------------------------------------- +! commom.bounds +! common /bounds/ +!----------------------------------------------------------------------------- ! commom.chain ! common /chain/ ! common /rotmat/ @@ -84,13 +87,16 @@ ! Define the origin and orientation of the coordinate system and locate the ! first three CA's and SC(2). ! +!elwrite(iout,*)"in chainbuild" call orig_frame +!elwrite(iout,*)"after orig_frame" ! ! Build the alpha-carbon chain. ! do i=4,nres call locate_next_res(i) enddo +!elwrite(iout,*)"after locate_next_res" ! ! First and last SC must coincide with the corresponding CA. ! @@ -407,6 +413,7 @@ #ifdef WHAM_RUN vbld(nres+1)=0.0d0 +!write(iout,*)"geometry warring, vbld=",(vbld(i),i=1,nres+1) vbld(2*nres)=0.0d0 vbld_inv(nres+1)=0.0d0 vbld_inv(2*nres)=0.0d0 @@ -503,11 +510,19 @@ #endif do i=1,nres-1 do j=1,3 +!#ifdef WHAM_RUN +#if defined(WHAM_RUN) || defined(CLUSTER) + dc(j,i)=c(j,i+1)-c(j,i) +#endif dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) enddo enddo do i=2,nres-1 do j=1,3 +!#ifdef WHAM_RUN +#if defined(WHAM_RUN) || defined(CLUSTER) + dc(j,i+nres)=c(j,i+nres)-c(j,i) +#endif dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) enddo enddo @@ -524,7 +539,7 @@ #endif return end subroutine int_from_cart1 -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- ! check_sc_distr.f !----------------------------------------------------------------------------- @@ -642,14 +657,18 @@ ii=ialph(i,2) alph(ii)=x(nphi+ntheta+i) omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) +!elwrite(iout,*) "alph",ii,alph +!elwrite(iout,*) "omeg",ii,omeg enddo endif do i=4,nres phi(i)=x(i-3) +!elwrite(iout,*) "phi",i,phi enddo if (n.eq.nphi) return do i=3,nres theta(i)=x(i-2+nphi) +!elwrite(iout,*) "theta",i,theta if (theta(i).eq.pi) theta(i)=0.99d0*pi x(i-2+nphi)=theta(i) enddo @@ -751,7 +770,7 @@ thetnorm=xx return end function thetnorm -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- subroutine var_to_geom_restr(n,xx) ! @@ -1321,7 +1340,7 @@ 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 (iout,'(a,i4,a,3e15.5)') 'CG Processor:',me,': bad sampling box.',box(1,2),box(2,2),radmax write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' #else ! write (iout,'(a)') 'Bad sampling box.' @@ -1807,7 +1826,7 @@ dist=dsqrt(x12*x12+y12*y12+z12*z12) return end function dist -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- ! local_move.f !----------------------------------------------------------------------------- @@ -2830,16 +2849,32 @@ endif endif do i=1,nres-1 +!in wham do i=1,nres 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 !test stop endif +!#ifndef WHAM_RUN vbld(i+1)=dist(i,i+1) vbld_inv(i+1)=1.0d0/vbld(i+1) +!#endif 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 +!el ----- +!#ifdef WHAM_RUN +! 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 +!#endif ! if (unres_pdb) then ! if (itype(1).eq.21) then ! theta(3)=90.0d0*deg2rad @@ -2859,9 +2894,11 @@ do j=1,3 c(j,nres2)=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)) +! in wham c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1) enddo iti=itype(i) di=dist(i,nres+i) +!#ifndef WHAM_RUN ! 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)) @@ -2871,6 +2908,7 @@ else vbld_inv(i+nres)=0.0d0 endif +!#endif if (iti.ne.10) then alph(i)=alpha(nres+i,i,nres2) omeg(i)=beta(nres+i,i,nres2,i+1) @@ -2940,7 +2978,9 @@ sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) it=itype(i) - if (it.ne.10) then + + if ((it.ne.10).and.(it.ne.ntyp1)) then +!el if (it.ne.10) then ! ! Compute the axes of tghe local cartesian coordinates system; store in ! x_prime, y_prime and z_prime @@ -2985,6 +3025,7 @@ yyref(i),zzref(i) enddo endif + return end subroutine sc_loc_geom !----------------------------------------------------------------------------- @@ -3004,7 +3045,7 @@ enddo return end subroutine sccenter -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- subroutine bond_regular use calc_data @@ -3375,7 +3416,7 @@ ! The side-chain vector derivatives return end subroutine int_to_cart -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- ! readrtns_CSA.F !----------------------------------------------------------------------------- @@ -3431,7 +3472,7 @@ !d & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj, !d & dhpb(i),forcon(i) !d enddo - deallocate(itype_pdb) +! deallocate(itype_pdb) return end subroutine gen_dist_constr @@ -3479,10 +3520,26 @@ ! real(kind=8),dimension(:,:),allocatable :: c !(3,maxres2+2) ! real(kind=8),dimension(:,:),allocatable :: dc allocate(dc_old(3,0:nres2)) - if(.not.allocated(dc_norm2)) allocate(dc_norm2(3,0:nres2)) !(3,0:maxres2) +! if(.not.allocated(dc_norm2)) allocate(dc_norm2(3,0:nres2+2)) !(3,0:maxres2) + if(.not.allocated(dc_norm2)) then + allocate(dc_norm2(3,0:nres2+2)) !(3,0:maxres2) + do i=0,nres2+2 + dc_norm2(1,i)=0.d0 + dc_norm2(2,i)=0.d0 + dc_norm2(3,i)=0.d0 + enddo + endif +! !el if(.not.allocated(dc_norm)) !elwrite(iout,*) "jestem w alloc geo 1" - if(.not.allocated(dc_norm)) allocate(dc_norm(3,0:nres2)) !(3,0:maxres2) + if(.not.allocated(dc_norm)) then + allocate(dc_norm(3,0:nres2+2)) !(3,0:maxres2) + do i=0,nres2+2 + dc_norm(1,i)=0.d0 + dc_norm(2,i)=0.d0 + dc_norm(3,i)=0.d0 + enddo + endif !elwrite(iout,*) "jestem w alloc geo 1" allocate(xloc(3,nres),xrot(3,nres)) !elwrite(iout,*) "jestem w alloc geo 1" @@ -3533,8 +3590,21 @@ if(.not.allocated(yyref)) allocate(yyref(nres)) if(.not.allocated(zzref)) allocate(zzref(nres)) !(maxres) allocate(ialph(nres,2)) !(maxres,2) + ialph(:,1)=0 + ialph(:,2)=0 allocate(ivar(4*nres2)) !(4*maxres2) +#if defined(WHAM_RUN) || defined(CLUSTER) + allocate(vbld(2*nres)) + do i=1,2*nres + vbld(i)=0.d0 + enddo + allocate(vbld_inv(2*nres)) + do i=1,2*nres + vbld_inv(i)=0.d0 + enddo +#endif + return end subroutine alloc_geo_arrays !----------------------------------------------------------------------------- diff --git a/source/unres/geometry_data.f90 b/source/unres/geometry_data.f90 deleted file mode 100644 index 4991521..0000000 --- a/source/unres/geometry_data.f90 +++ /dev/null @@ -1,60 +0,0 @@ - module geometry_data -!----------------------------------------------------------------------------- -! commom.bounds -! common /bounds/ - real(kind=8),dimension(:,:),allocatable :: phibound !(2,maxres) -!----------------------------------------------------------------------------- -! commom.chain -! common /chain/ - real(kind=8),dimension(:,:),allocatable :: c !(3,maxres2+2) - real(kind=8),dimension(:,:),allocatable :: dc,dc_old,& - dc_norm,dc_norm2 !(3,0:maxres2) - real(kind=8),dimension(:,:),allocatable :: xloc,xrot !(3,maxres) - real(kind=8),dimension(:),allocatable :: dc_work !(MAXRES6) - integer :: nres,nres0 -! common /rotmat/ - real(kind=8),dimension(:,:,:),allocatable :: prod,rt !(3,3,maxres) -! common /refstruct/ - real(kind=8),dimension(:,:,:),allocatable :: cref !(3,maxres2+2,maxperm), - real(kind=8),dimension(:,:),allocatable :: crefjlee !(3,maxres2+2), - real(kind=8),dimension(:,:,:),allocatable :: chain_rep !(3,maxres2+2,maxsym) - integer :: nsup,nstart_sup,nstart_seq,chain_length,iprzes,nperm - integer :: nend_sup,ishift_pdb !wham - real(kind=8) :: rmssing,anatemp !wham - integer,dimension(:,:),allocatable :: tabperm !(maxperm,maxsym) -! common /from_zscore/ in module.compare -!----------------------------------------------------------------------------- -! common.geo -! common /geo/ - real(kind=8) :: pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin -!----------------------------------------------------------------------------- -! common.local -! Inverses of the actual virtual bond lengths -! common /invlen/ - real(kind=8),dimension(:),allocatable :: vbld_inv !(maxres2) -!----------------------------------------------------------------------------- -! Max. number of lobes in SC distribution - integer,parameter :: maxlob=4 -!----------------------------------------------------------------------------- -! Max number of symetric chains - integer,parameter :: maxsym=50 - integer,parameter :: maxperm=120 -!----------------------------------------------------------------------------- -! common.var -! Store the geometric variables in the following COMMON block. -! common /var/ - real(kind=8),dimension(:),allocatable :: theta,phi,alph,omeg,& - thetaref,phiref,costtab,sinttab,cost2tab,sint2tab !(maxres) - real(kind=8),dimension(:),allocatable :: vbld !(2*maxres) - real(kind=8),dimension(:,:),allocatable :: omicron !(2,maxres) - real(kind=8),dimension(:,:),allocatable :: tauangle !(3,maxres) - real(kind=8),dimension(:),allocatable :: xxtab,yytab,zztab,& - xxref,yyref,zzref !(maxres) - integer,dimension(:,:),allocatable :: ialph !(maxres,2) - integer,dimension(:),allocatable :: ivar !(4*maxres2) - integer :: ntheta,nphi,nside,nvar -!----------------------------------------------------------------------------- - integer,dimension(:),allocatable :: itype_pdb !(maxres) initialize in molread -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module geometry_data diff --git a/source/unres/io.f90 b/source/unres/io.f90 index acbbc3d..328d27b 100644 --- a/source/unres/io.f90 +++ b/source/unres/io.f90 @@ -632,6 +632,7 @@ endif #endif ! print *,"Processor",myrank," leaves READRTNS" +! write(iout,*) "end readrtns" return end subroutine readrtns !----------------------------------------------------------------------------- @@ -639,6 +640,7 @@ ! ! Read molecular data. ! +! use control, only: ilen use control_data use geometry_data use energy_data @@ -703,13 +705,13 @@ ! Zero out tables. ! do i=1,2*maxres - do j=1,3 - c(j,i)=0.0D0 - dc(j,i)=0.0D0 + do j=1,3 + c(j,i)=0.0D0 + dc(j,i)=0.0D0 enddo enddo do i=1,maxres - itype(i)=0 + itype(i)=0 enddo !----------------------------- ! @@ -885,7 +887,7 @@ ! print *,'Finished reading pdb data' if(me.eq.king.or..not.out1file) & write (iout,'(a,i3,a,i3)')'nsup=',nsup,& - ' nstart_sup=',nstart_sup,"ergwergewrgae" + ' nstart_sup=',nstart_sup !,"ergwergewrgae" !el if(.not.allocated(itype_pdb)) allocate(itype_pdb(nres)) do i=1,nres @@ -933,8 +935,11 @@ itype(i)=rescode(i,sequence(i),iscode) enddo ! Assign initial virtual bond lengths +!elwrite(iout,*) "test_alloc" if(.not.allocated(vbld)) allocate(vbld(2*nres)) +!elwrite(iout,*) "test_alloc" if(.not.allocated(vbld_inv)) allocate(vbld_inv(2*nres)) +!elwrite(iout,*) "test_alloc" do i=2,nres vbld(i)=vbl vbld_inv(i)=vblinv @@ -950,34 +955,34 @@ ! print '(20i4)',(itype(i),i=1,nres) !---------------------------- !el reallocate tables - do i=1,maxres2 - do j=1,3 - c_alloc(j,i)=c(j,i) - dc_alloc(j,i)=dc(j,i) - enddo - enddo - do i=1,maxres +! do i=1,maxres2 +! do j=1,3 +! c_alloc(j,i)=c(j,i) +! dc_alloc(j,i)=dc(j,i) +! enddo +! enddo +! do i=1,maxres !elwrite(iout,*) "itype",i,itype(i) - itype_alloc(i)=itype(i) - enddo +! itype_alloc(i)=itype(i) +! enddo - deallocate(c) - deallocate(dc) - deallocate(itype) - allocate(c(3,2*nres+2)) - allocate(dc(3,0:2*nres)) - allocate(itype(nres+2)) +! deallocate(c) +! deallocate(dc) +! deallocate(itype) +! allocate(c(3,2*nres+2)) +! allocate(dc(3,0:2*nres+2)) +! allocate(itype(nres+2)) allocate(itel(nres+2)) - do i=1,2*nres - do j=1,3 - c(j,i)=c_alloc(j,i) - dc(j,i)=dc_alloc(j,i) - enddo - enddo +! do i=1,2*nres+2 +! do j=1,3 +! c(j,i)=c_alloc(j,i) +! dc(j,i)=dc_alloc(j,i) +! enddo +! enddo do i=1,nres+2 - itype(i)=itype_alloc(i) - itel(i)=0 +! itype(i)=itype_alloc(i) + itel(i)=0 enddo !-------------------------- do i=1,nres @@ -992,9 +997,9 @@ #else else if (iabs(itype(i)).ne.20) then #endif - itel(i)=1 + itel(i)=1 else - itel(i)=2 + itel(i)=2 endif enddo if(me.eq.king.or..not.out1file)then @@ -1088,7 +1093,7 @@ 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,"242343453254" + ' nstart_seq=',nstart_seq !,"242343453254" endif !--- Zscore rms ------- if (nz_start.eq.0) nz_start=nnt diff --git a/source/unres/io_base.f90 b/source/unres/io_base.f90 index f5c7bbf..f86b4dd 100644 --- a/source/unres/io_base.f90 +++ b/source/unres/io_base.f90 @@ -5,10 +5,18 @@ implicit none !----------------------------------------------------------------------------- ! Max. number of AA residues - integer,parameter :: maxres=4000!1200 + integer,parameter :: maxres=6000!1200 ! Appr. max. number of interaction sites integer,parameter :: maxres2=2*maxres +! parameter (maxres6=6*maxres) +! parameter (mmaxres2=(maxres2*(maxres2+1)/2)) !----------------------------------------------------------------------------- +! Max. number of S-S bridges +! integer,parameter :: maxss=20 +!----------------------------------------------------------------------------- +! Max. number of derivatives of virtual-bond and side-chain vectors in theta +! or phi. +! integer,parameter :: maxdim=(maxres-1)*(maxres-2)/2 !----------------------------------------------------------------------------- ! ! @@ -77,7 +85,7 @@ enddo ! Read preformed bridges. if (ns.gt.0) then - read (inp,*) nss + read (inp,*) nss if (nss.gt.0) then if(.not.allocated(ihpb)) allocate(ihpb(nss)) if(.not.allocated(jhpb)) allocate(jhpb(nss)) @@ -133,7 +141,7 @@ enddo endif endif -!write(iout,*) "end read_bridge" +! write(iout,*) "end read_bridge" return end subroutine read_bridge !----------------------------------------------------------------------------- @@ -151,12 +159,11 @@ ! include 'COMMON.CONTROL' ! include 'COMMON.LOCAL' ! include 'COMMON.INTERACT' +! Read coordinates from input ! !el local variables integer :: l,k,j,i,kanal -! Read coordinates from input -! 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) @@ -241,7 +248,8 @@ end subroutine read_threadbase !----------------------------------------------------------------------------- #ifdef WHAM_RUN - subroutine read_angles(kanal,iscor,energ,iprot,*) +!el subroutine read_angles(kanal,iscor,energ,iprot,*) + subroutine read_angles(kanal,*) use geometry_data use energy_data @@ -261,6 +269,8 @@ subroutine read_angles(kanal,*) use geometry_data + ! use energy + ! use control ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' @@ -412,6 +422,7 @@ !----------------------------------------------------------------------------- subroutine read_dist_constr use MPI_data + ! use control use geometry, only: dist use geometry_data use control_data @@ -833,6 +844,7 @@ use geometry_data, only: c,nres use energy_data + ! use control use compare_data use MD_data ! implicit real*8 (a-h,o-z) @@ -992,6 +1004,7 @@ ! format. use geometry_data, only: c use energy_data + ! use control ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CHAIN' @@ -1081,10 +1094,14 @@ return end subroutine intout !----------------------------------------------------------------------------- +#ifdef CLUSTER + subroutine briefout(it,ener,free)!,plik) +#else subroutine briefout(it,ener) - +#endif use geometry_data use energy_data + ! use control ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' @@ -1098,10 +1115,9 @@ ! print '(a,i5)',intname,igeom !el local variables integer :: i,it - real(kind=8) :: ener -#ifdef WHAM_RUN - integer :: iii -#endif + real(kind=8) :: ener,free +! character(len=80) :: plik +! integer :: iii #if defined(AIX) || defined(PGI) open (igeom,file=intname,position='append') @@ -1109,13 +1125,19 @@ open (igeom,file=intname,access='append') #endif #ifdef WHAM_RUN - iii=igeom +! iii=igeom igeom=iout #endif IF (NSS.LE.9) THEN +#ifdef CLUSTER + WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,NSS) + ELSE + WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,8) +#else 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) +#endif WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) ENDIF ! IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) @@ -1226,5 +1248,79 @@ end subroutine reads #endif !----------------------------------------------------------------------------- +! permut.F +!----------------------------------------------------------------------------- + subroutine permut(isym) + + use geometry_data, only: tabperm +! 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' + + integer :: n,isym +! logical nextp +!el external nextp + integer,dimension(isym) :: a +! parameter(n=symetr) +!el local variables + integer :: kkk,i + + n=isym + if (n.eq.1) then + tabperm(1,1)=1 + return + endif + kkk=0 + do i=1,n + a(i)=i + enddo + 10 print *,(a(i),i=1,n) + kkk=kkk+1 + do i=1,n + tabperm(kkk,i)=a(i) +! write (iout,*) "tututu", kkk + enddo + if(nextp(n,a)) go to 10 + return + end subroutine permut +!----------------------------------------------------------------------------- + logical function nextp(n,a) + + integer :: n,i,j,k,t +! logical :: nextp + integer,dimension(n) :: a + i=n-1 + 10 if(a(i).lt.a(i+1)) go to 20 + i=i-1 + if(i.eq.0) go to 20 + go to 10 + 20 j=i+1 + k=n + 30 t=a(j) + a(j)=a(k) + a(k)=t + j=j+1 + k=k-1 + if(j.lt.k) go to 30 + j=i + if(j.ne.0) go to 40 + nextp=.false. + return + 40 j=j+1 + if(a(j).lt.a(i)) go to 40 + t=a(i) + a(i)=a(j) + a(j)=t + nextp=.true. + return + end function nextp +!----------------------------------------------------------------------------- !----------------------------------------------------------------------------- end module io_base diff --git a/source/unres/io_config.f90 b/source/unres/io_config.f90 index 0b10e11..490ecad 100644 --- a/source/unres/io_config.f90 +++ b/source/unres/io_config.f90 @@ -5,6 +5,7 @@ use io_base use geometry_data use geometry + use control_data, only:maxterm_sccor implicit none !----------------------------------------------------------------------------- ! Max. number of residue types and parameters in expressions for @@ -21,7 +22,7 @@ ! parameter (maxtor=4,maxterm=10) !----------------------------------------------------------------------------- ! Max number of torsional terms in SCCOR - integer,parameter :: maxterm_sccor=6 +!el integer,parameter :: maxterm_sccor=6 !----------------------------------------------------------------------------- character(len=1),dimension(:),allocatable :: secstruc !(maxres) !----------------------------------------------------------------------------- @@ -29,7 +30,7 @@ ! !----------------------------------------------------------------------------- contains -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- ! bank.F io_csa !----------------------------------------------------------------------------- @@ -575,15 +576,15 @@ endif enddo ndih_constr=ii - deallocate(secstruc) +! deallocate(secstruc) return 100 continue write(iout,'(A30,A80)')'Error reading file SECPRED',secpred - deallocate(secstruc) +! deallocate(secstruc) return 110 continue write(iout,'(A20)')'Error reading FTORS' - deallocate(secstruc) +! deallocate(secstruc) return end subroutine secstrp2dihc !----------------------------------------------------------------------------- @@ -689,7 +690,7 @@ ' in position',i4) return end subroutine read_secstr_pred -#endif +!#endif !----------------------------------------------------------------------------- ! parmread.F !----------------------------------------------------------------------------- @@ -747,7 +748,6 @@ ! real(kind=8),dimension(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) :: v1_el,v2_el !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) !el allocate(v1_el(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)) !el allocate(v2_el(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)) - ! ! For printing parameters after they are read set the following in the UNRES ! C-shell script: @@ -783,6 +783,9 @@ allocate(restok(ntyp+1)) !(ntyp+1) allocate(abond0(maxbondterm,ntyp)) !(maxbondterm,ntyp) + dsc(:)=0.0d0 + dsc_inv(:)=0.0d0 + #ifdef CRYST_BOND read (ibond,*) vbldp0,akp,mp,ip,pstok do i=1,ntyp @@ -1465,8 +1468,10 @@ do i=-ntyp,-1 itortyp(i)=-itortyp(-i) enddo - write (iout,*) 'ntortyp',ntortyp +! itortyp(ntyp1)=ntortyp +! itortyp(-ntyp1)=-ntortyp do iblock=1,2 + 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),& @@ -1543,7 +1548,7 @@ if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) & .or. t3.ne.toronelet(k)) then - write (iout,*) "Error in double torsional parameter file",& + write (iout,*) "Error in double torsional parameter file",& i,j,k,t1,t2,t3 #ifdef MPI call MPI_Finalize(Ierror) @@ -1797,7 +1802,7 @@ write (iout,*) "Coefficients of the cumulants" endif read (ifourier,*) nloctyp -write(iout,*) "nloctyp",nloctyp +!write(iout,*) "nloctyp",nloctyp !el from module energy------- allocate(b1(2,-nloctyp-1:nloctyp+1)) !(2,-maxtor:maxtor) allocate(b2(2,-nloctyp-1:nloctyp+1)) !(2,-maxtor:maxtor) @@ -1807,14 +1812,17 @@ write(iout,*) "nloctyp",nloctyp allocate(ee(2,2,-nloctyp-1:nloctyp+1)) allocate(ctilde(2,2,-nloctyp-1:nloctyp+1)) allocate(dtilde(2,2,-nloctyp-1:nloctyp+1)) !(2,2,-maxtor:maxtor) +! el + b1(1,:)=0.0d0 + b1(2,:)=0.0d0 !-------------------------------- 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) + 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) @@ -1921,7 +1929,6 @@ write(iout,*) "nloctyp",nloctyp enddo enddo endif - ! ! Read electrostatic-interaction parameters ! @@ -1984,72 +1991,85 @@ write(iout,*) "nloctyp",nloctyp if(me.eq.king) & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot),& ', exponents are ',expon,2*expon - goto (10,20,30,30,40) ipot +! goto (10,20,30,30,40) ipot + select case(ipot) !----------------------- 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 + case (1) +! 10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),& + 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 !----------------------- 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 + case(2) +! 20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),& + 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 !---------------------- 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) -! 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) + case(3:4) +! 30 do i=1,ntyp + do i=1,ntyp + read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) 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 + 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) +! 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 !--------------------- 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 + case(5) +! 40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),& + 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 + case default + write(iout,*)"Wrong ipot" +! 50 continue + end select + continue close (isidep) !----------------------------------------------------------------------- ! Calculate the "working" parameters of SC interactions. @@ -2058,19 +2078,19 @@ write(iout,*) "nloctyp",nloctyp allocate(aa(ntyp1,ntyp1),bb(ntyp1,ntyp1),chi(ntyp1,ntyp1)) !(ntyp,ntyp) allocate(sigma(0:ntyp1,0:ntyp1),r0(ntyp1,ntyp1)) !(0:ntyp1,0:ntyp1) do i=1,ntyp1 - do j=1,ntyp1 - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 - chi(i,j)=0.0D0 - sigma(i,j)=0.0D0 - r0(i,j)=0.0D0 + do j=1,ntyp1 + aa(i,j)=0.0D0 + bb(i,j)=0.0D0 + chi(i,j)=0.0D0 + sigma(i,j)=0.0D0 + r0(i,j)=0.0D0 enddo enddo !-------------------------------- do i=2,ntyp do j=1,i-1 - eps(i,j)=eps(j,i) + eps(i,j)=eps(j,i) enddo enddo do i=1,ntyp @@ -2259,88 +2279,7 @@ write(iout,*) "nloctyp",nloctyp stop return end subroutine parmread -!----------------------------------------------------------------------------- -! permut.F -!----------------------------------------------------------------------------- - subroutine permut(isym) - - use geometry_data, only: tabperm -! use energy_data -! use control_data, only:lsecondary -! use MD_data -! use MPI_data -! use map_data -! use energy -! use geometry -! use control -! 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' - - integer :: n,isym -! logical nextp -!el external nextp - integer,dimension(isym) :: a -! parameter(n=symetr) -!el local variables - integer :: kkk,i - - n=isym - if (n.eq.1) then - tabperm(1,1)=1 - return - endif - kkk=0 - do i=1,n - a(i)=i - enddo - 10 print *,(a(i),i=1,n) - kkk=kkk+1 - do i=1,n - tabperm(kkk,i)=a(i) -! write (iout,*) "tututu", kkk - enddo - if(nextp(n,a)) go to 10 - return - end subroutine permut -!----------------------------------------------------------------------------- - logical function nextp(n,a) - - integer :: n,i,j,k,t -! logical :: nextp - integer,dimension(n) :: a - i=n-1 - 10 if(a(i).lt.a(i+1)) go to 20 - i=i-1 - if(i.eq.0) go to 20 - go to 10 - 20 j=i+1 - k=n - 30 t=a(j) - a(j)=a(k) - a(k)=t - j=j+1 - k=k-1 - if(j.lt.k) go to 30 - j=i - if(j.ne.0) go to 40 - nextp=.false. - return - 40 j=j+1 - if(a(j).lt.a(i)) go to 40 - t=a(i) - a(i)=a(j) - a(j)=t - nextp=.true. - return - end function nextp +#endif !----------------------------------------------------------------------------- ! printmat.f !----------------------------------------------------------------------------- @@ -2389,7 +2328,7 @@ write(iout,*) "nloctyp",nloctyp ! include 'COMMON.CONTROL' ! include 'COMMON.DISTFIT' ! include 'COMMON.SETUP' - integer :: i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity!,& + integer :: i,j,ibeg,ishift1,ires,iii,ires_old,ishift!,ity!,& ! ishift_pdb logical :: lprn=.true.,fail real(kind=8),dimension(3) :: e1,e2,e3 @@ -2421,26 +2360,24 @@ write(iout,*) "nloctyp",nloctyp allocate(hfrag(2,maxres/3)) !(2,maxres/3) allocate(bfrag(4,maxres/3)) !(4,maxres/3) -!elwrite(iout,*)"poczatek read pdb" - do i=1,100000 read (ipdbin,'(a80)',end=10) card ! write (iout,'(a)') 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) + 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) + nbfrag=nbfrag+1 + lsecondary=.true. + read(card(24:26),*) bfrag(1,nbfrag) + read(card(35:37),*) bfrag(2,nbfrag) !rc---------------------------------------- !rc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) + bfrag(3,nbfrag)=bfrag(1,nbfrag) + bfrag(4,nbfrag)=bfrag(2,nbfrag) !rc---------------------------------------- endif if (card(:3).eq.'END') then @@ -2501,13 +2438,13 @@ write(iout,*) "nloctyp",nloctyp endif ires=ires-ishift+ishift1 ires_old=ires -! write (iout,*) "ishift",ishift," ires",ires, -! & " ires_old",ires_old +! write (iout,*) "ishift",ishift," ires",ires,& +! " ires_old",ires_old ibeg=0 else if (ibeg.eq.2) then ! Start a new chain -! ishift=-ires_old+ires-1 -! ishift1=ishift1+1 + ishift=-ires_old+ires-1 !!!!! + ishift1=ishift1-1 !!!!! ! write (iout,*) "New chain started",ires,ishift,ishift1,"!" ires=ires-ishift+ishift1 ires_old=ires @@ -2529,11 +2466,11 @@ write(iout,*) "nloctyp",nloctyp if (card(27:27).eq."A" .or. card(27:27).eq."B") then ! ishift1=ishift1+1 endif -! write (2,*) "ires",ires," res ",res," ity",ity +! 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) -! write (iout,*) "backbone ",atom +! write (iout,*) "backbone ",atom #ifdef DEBUG write (iout,'(2i3,2x,a,3f8.3)') & ires,itype(ires),res,(c(j,ires),j=1,3) @@ -2606,32 +2543,32 @@ write(iout,*) "nloctyp",nloctyp endif !--------------------------------- !el reallocate tables - do i=1,maxres/3 - do j=1,2 - hfrag_alloc(j,i)=hfrag(j,i) - enddo - do j=1,4 - bfrag_alloc(j,i)=bfrag(j,i) - enddo - enddo +! do i=1,maxres/3 +! do j=1,2 +! hfrag_alloc(j,i)=hfrag(j,i) +! enddo +! do j=1,4 +! bfrag_alloc(j,i)=bfrag(j,i) +! enddo +! enddo - deallocate(hfrag) - deallocate(bfrag) - allocate(hfrag(2,nres/3)) !(2,maxres/3) +! deallocate(hfrag) +! deallocate(bfrag) +! allocate(hfrag(2,nres/3)) !(2,maxres/3) !el allocate(hfrag(2,nhfrag)) !(2,maxres/3) !el allocate(bfrag(4,nbfrag)) !(4,maxres/3) - allocate(bfrag(4,nres/3)) !(4,maxres/3) +! allocate(bfrag(4,nres/3)) !(4,maxres/3) - do i=1,nhfrag - do j=1,2 - hfrag(j,i)=hfrag_alloc(j,i) - enddo - enddo - do i=1,nbfrag - do j=1,4 - bfrag(j,i)=bfrag_alloc(j,i) - enddo - enddo +! do i=1,nhfrag +! do j=1,2 +! hfrag(j,i)=hfrag_alloc(j,i) +! enddo +! enddo +! do i=1,nbfrag +! do j=1,4 +! bfrag(j,i)=bfrag_alloc(j,i) +! enddo +! enddo !el end reallocate tables !--------------------------------- do i=2,nres-1 @@ -2694,13 +2631,52 @@ write(iout,*) "nloctyp",nloctyp enddo endif - if(.not.allocated(vbld)) allocate(vbld(2*nres)) - if(.not.allocated(vbld_inv)) allocate(vbld_inv(2*nres)) - if(.not.allocated(theta)) allocate(theta(nres+2)) + if(.not.allocated(vbld)) then + allocate(vbld(2*nres)) + do i=1,2*nres + vbld(i)=0.d0 + enddo + endif + if(.not.allocated(vbld_inv)) then + allocate(vbld_inv(2*nres)) + do i=1,2*nres + vbld_inv(i)=0.d0 + enddo + endif +!!!el + if(.not.allocated(theta)) then + allocate(theta(nres+2)) +! allocate(phi(nres+2)) +! allocate(alph(nres+2)) +! allocate(omeg(nres+2)) + do i=1,nres+2 + theta(i)=0.0d0 +! phi(i)=0.0d0 +! alph(i)=0.0d0 +! omeg(i)=0.0d0 + enddo + endif +! allocate(costtab(nres)) +! allocate(sinttab(nres)) +! allocate(cost2tab(nres)) +! allocate(sint2tab(nres)) +! allocate(xxref(nres)) +! allocate(yyref(nres)) +! allocate(zzref(nres)) !(maxres) +! do i=1,nres +! costtab(i)=0.0d0 +! sinttab(i)=0.0d0 +! cost2tab(i)=0.0d0 +! sint2tab(i)=0.0d0 +! xxref(i)=0.0d0 +! yyref(i)=0.0d0 +! zzref(i)=0.0d0 +! enddo + +! endif if(.not.allocated(phi)) allocate(phi(nres+2)) if(.not.allocated(alph)) allocate(alph(nres+2)) if(.not.allocated(omeg)) allocate(omeg(nres+2)) - if(.not.allocated(theta)) allocate(theta(nres+2)) if(.not.allocated(thetaref)) allocate(thetaref(nres+2)) if(.not.allocated(phiref)) allocate(phiref(nres+2)) if(.not.allocated(costtab)) allocate(costtab(nres)) @@ -2710,23 +2686,35 @@ write(iout,*) "nloctyp",nloctyp if(.not.allocated(xxref)) allocate(xxref(nres)) if(.not.allocated(yyref)) allocate(yyref(nres)) if(.not.allocated(zzref)) allocate(zzref(nres)) !(maxres) - if(.not.allocated(theta)) allocate(theta(nres)) - if(.not.allocated(dc_norm)) allocate(dc_norm(3,0:2*nres)) - if(.not.allocated(theta)) allocate(theta(nres)) + if(.not.allocated(dc_norm)) then +! if(.not.allocated(dc_norm)) allocate(dc_norm(3,0:2*nres+2)) + allocate(dc_norm(3,0:2*nres+2)) + do i=0,2*nres+2 + dc_norm(1,i)=0.d0 + dc_norm(2,i)=0.d0 + dc_norm(3,i)=0.d0 + enddo + endif + call int_from_cart(.true.,.false.) call sc_loc_geom(.true.) +! call sc_loc_geom(.false.) ! wczesbiej bylo false do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) enddo +! do i=1,2*nres +! vbld_inv(i)=0.d0 +! vbld(i)=0.d0 +! 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) @@ -2745,9 +2733,9 @@ write(iout,*) "nloctyp",nloctyp ! enddo ! enddo ! - allocate(cref(3,2*nres+2,maxperm)) !(3,maxres2+2,maxperm) - allocate(chain_rep(3,2*nres+2,maxsym)) !(3,maxres2+2,maxsym) - allocate(tabperm(maxperm,maxsym)) !(maxperm,maxsym) + if(.not.allocated(cref)) allocate(cref(3,2*nres+2,maxperm)) !(3,maxres2+2,maxperm) + if(.not.allocated(chain_rep)) allocate(chain_rep(3,2*nres+2,maxsym)) !(3,maxres2+2,maxsym) + if(.not.allocated(tabperm)) allocate(tabperm(maxperm,maxsym)) !(maxperm,maxsym) !----------------------------- kkk=1 lll=0 @@ -2850,29 +2838,10 @@ write(iout,*) "nloctyp",nloctyp enddo enddo ishift_pdb=ishift -!--------------------- -! el reallocate array - do i=1,2*nres+2 - do kkk=1,nperm - cref_alloc(1,i,kkk)=cref(1,i,kkk) - cref_alloc(2,i,kkk)=cref(2,i,kkk) - cref_alloc(3,i,kkk)=cref(3,i,kkk) - enddo - enddo -!el deallocate(cref) -!el allocate(cref(3,2*nres+2,nperm)) !(3,maxres2+2,maxperm) - - do i=1,2*nres+2 - do kkk=1,nperm - cref(1,i,kkk)=cref_alloc(1,i,kkk) - cref(2,i,kkk)=cref_alloc(2,i,kkk) - cref(3,i,kkk)=cref_alloc(3,i,kkk) - enddo - enddo -!--------------------- + return end subroutine readpdb -#ifndef WHAM_RUN +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) !----------------------------------------------------------------------------- ! readrtns_CSA.F !----------------------------------------------------------------------------- @@ -3603,7 +3572,6 @@ write(iout,*) "nloctyp",nloctyp use energy_data, only: usampl use csa_data use MPI_data -! use MD use control_data, only:out1file use control, only: getenv_loc ! implicit real*8 (a-h,o-z) @@ -3939,8 +3907,12 @@ write(iout,*) "nloctyp",nloctyp thetname(:ilen(thetname)) write (iout,*) "Rotamer parameter file : ",& rotname(:ilen(rotname)) +!el---- +#ifndef CRYST_THETA write (iout,*) "Thetpdb parameter file : ",& thetname_pdb(:ilen(thetname_pdb)) +#endif +!el write (iout,*) "Threading database : ",& patname(:ilen(patname)) if (lentmp.ne.0) & diff --git a/source/unres/io_units.f90 b/source/unres/io_units.f90 deleted file mode 100644 index 9e96c0e..0000000 --- a/source/unres/io_units.f90 +++ /dev/null @@ -1,63 +0,0 @@ - module io_units -!----------------------------------------------------------------------- -! common.iounits -! I/O units used by the program -!----------------------------------------------------------------------- -! 9/18/99 - unit ifourier and filename fouriername included to identify -! the file from which the coefficients of second-order Fourier expansion -! of the local-interaction energy are read. -! 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) -! included. -!----------------------------------------------------------------------- -! General I/O units & files -! common /iounits/ - 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 -#ifdef WHAM_RUN -! el wham iounits - integer :: isidep1,ihist,iweight,izsc,idistr -#endif -! common /fnames/ - character(len=256) :: outname,intname,pdbname,mol2name,statname,& - intinname,entname,prefix,secpred,rest2name,qname,cartname,& - tmpdir,mremd_rst_name,curdir,pref_orig - -!#ifdef WHAM_RUN -! el wham iounits - character(len=256) :: restartnam,scratchdir,sidepname,pdbfile,& - histname,zscname - character(len=4) :: liczba - character(len=3) :: pot -!#endif -! Parameter files -! common /parfiles/ - character(len=256) :: bondname,thetname,rotname,torname,tordname,& - fouriername,elename,sidename,scpname,sccorname,patname,& - thetname_pdb,rotname_pdb -!----------------------------------------------------------------------- -! INP - main input file -! IOUT - list file -! IGEOM - geometry output in the form of virtual-chain internal coordinates -! INTIN - geometry input (for multiple conformation processing) in int. coords. -! IPDB - Cartesian-coordinate output in PDB format -! IMOL2 - Cartesian-coordinate output in Tripos mol2 format -! IPDBIN - PDB input file -! ITHEP - virtual-bond torsional angle parametrs -! IROTAM - side-chain geometry and local-interaction parameters -! ITORP - torsional parameters -! ITORDP - double torsional parameters -! IFOURIER - coefficients of the expansion of local-interaction energy -! IELEP - electrostatic-interaction parameters -! ISIDEP - side-chain interaction parameters. -! ISCPP - SCp interaction parameters. -! IBOND - virtual-bond constant parameters and moments of inertia. -! ISCCOR - parameters of the potential of SCCOR term -! ICBASE - data base with Cartesian coords of known structures. -! ISTAT - energies and other conf. characteristics from an MCM run. -! IENTIN - entropy from preceeding simulation(s) to be read in. -! SECPRED - SECONDARY STRUCTURE PREDICTION for dihedral constraint generation. -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module io_units diff --git a/source/unres/map.f90 b/source/unres/map.f90 index e15df64..b91d43e 100644 --- a/source/unres/map.f90 +++ b/source/unres/map.f90 @@ -173,7 +173,7 @@ ! call enerprint(energia) 10 continue enddo ! i - deallocate(x,g) +! deallocate(x,g) return end subroutine map !----------------------------------------------------------------------------- diff --git a/source/unres/map_data.f90 b/source/unres/map_data.f90 deleted file mode 100644 index b706d35..0000000 --- a/source/unres/map_data.f90 +++ /dev/null @@ -1,10 +0,0 @@ - module map_data -!----------------------------------------------------------------------------- -! commom.map -! common /mapp/ - integer :: nmap - integer,dimension(:),allocatable :: kang,res1,res2,nstep !(maxvar) - real(kind=8),dimension(:),allocatable :: ang_from,ang_to !(maxvar) -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module map_data diff --git a/source/unres/md_calc.f90 b/source/unres/md_calc.f90 index e602ef9..50f23d7 100644 --- a/source/unres/md_calc.f90 +++ b/source/unres/md_calc.f90 @@ -3,6 +3,7 @@ use io_units use MD_data, only:D_ban,IP use geometry_data +! use prng ! prng.f90 or prng_32.f90 implicit none ! !----------------------------------------------------------------------------- @@ -675,6 +676,7 @@ integer :: L,JL,JK,J,JM1,K real(kind=8) :: A(*) real(kind=8) :: D(L) +!el real(kind=8) :: E(L) real(kind=8) :: E(*)!el E(L) real(kind=8) :: F real(kind=8) :: G diff --git a/source/unres/minim.f90 b/source/unres/minim.f90 index 66726f4..4305640 100644 --- a/source/unres/minim.f90 +++ b/source/unres/minim.f90 @@ -3,11 +3,14 @@ use io_units use names use math +! use MPI_data use geometry_data use energy_data use control_data use minim_data use geometry +! use csa_data +! use energy implicit none !----------------------------------------------------------------------------- ! @@ -436,7 +439,7 @@ ! ! *** we did not. try a longer step unless this was a newton ! *** step. -! + v(radfac) = v(rdfcmx) gts = v(gtstep) if (v(fdif) .lt. (half/v(radfac) - one) * gts) & @@ -1743,6 +1746,7 @@ ! *** carry out humsl (unconstrained minimization) iterations, using ! *** hessian matrix provided by the caller. ! +!el use control use control, only:stopx ! *** parameter declarations *** @@ -3523,6 +3527,8 @@ integer :: n,i,ij,ig,igall real(kind=8),dimension(6*nres) :: xx,x !(maxvar) (maxvar=6*maxres) +!el allocate(varall(nvar)) allocated in alioc_ener_arrays + do i=1,nvar varall(i)=x(i) enddo @@ -3759,6 +3765,7 @@ use MPI_data use energy, only: cartgrad,zerograd,etotal +! use MD_data ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI @@ -4648,13 +4655,11 @@ enddo !elmask_r=.false. IF (mask_r) THEN -write(iout,*) "mask_r",mask_r,"petla if minimize_sc1" 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 -write(iout,*) "mask_r",mask_r,"petla else minimize_sc1" call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) ENDIF !el--------------------- @@ -4884,6 +4889,7 @@ write(iout,*) "mask_r",mask_r,"petla else minimize_sc1" ! use calc_data use energy, only: sc_grad +! use control, only:stopx ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' @@ -5027,6 +5033,7 @@ write(iout,*) "mask_r",mask_r,"petla else minimize_sc1" ! *** minimize general unconstrained objective function using *** ! *** analytic gradient and hessian approx. from secant update *** ! +! use control integer :: n, liv, lv integer :: iv(liv), uiparm(1) real(kind=8) :: d(n), x(n), v(lv), urparm(1) diff --git a/source/unres/minim_data.f90 b/source/unres/minim_data.f90 deleted file mode 100644 index cfa788d..0000000 --- a/source/unres/minim_data.f90 +++ /dev/null @@ -1,13 +0,0 @@ - module minim_data -!----------------------------------------------------------------------------- -! commom.minim -! common /minimm/ - real(kind=8) :: tolf,rtolf - integer :: maxfun,maxmin,minfun,minmin,& - print_min_ini,print_min_stat,print_min_res -!----------------------------------------------------------------------------- -! common /przechowalnia/ subroutines: minim_jlee,minimize,minim_dc, -! minim_mcmf,minimize_sc1 - real(kind=8),dimension(:),allocatable :: v !77+maxvar*(maxvar+17)/2 (maxvar=6*maxres) -!----------------------------------------------------------------------------- - end module minim_data diff --git a/source/unres/muca_md.f90 b/source/unres/muca_md.f90 index b72d882..79189a2 100644 --- a/source/unres/muca_md.f90 +++ b/source/unres/muca_md.f90 @@ -60,8 +60,6 @@ !----------------------------------------------------------------------------- subroutine muca_update(energy) - ! use remd - ! use MPI use control_data ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' diff --git a/source/unres/names.f90 b/source/unres/names.f90 deleted file mode 100644 index b97e5f0..0000000 --- a/source/unres/names.f90 +++ /dev/null @@ -1,66 +0,0 @@ - module names -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- -! Number of AA types (at present only natural AA's will be handled - integer,parameter :: ntyp=24,ntyp1=ntyp+1 -!----------------------------------------------------------------------------- -! common.names -! common /names/ -!el character(len=3),dimension(:),allocatable :: restyp !(-ntyp1:ntyp1) -!el character(len=1),dimension(:),allocatable :: onelet !(-ntyp1:ntyp1) -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- -! block data nazwy -!el allocate(restyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1) - character(len=3),dimension(-ntyp1:ntyp1) :: 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','SME','DBZ',& - 'AIB','ABU','D '/) -!el allocate(onelet(-ntyp1:ntyp1)) !(-ntyp1:ntyp1) - character(len=1),dimension(-ntyp1:ntyp1) :: 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','z','z','z','z','X'/) -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- -! Number of energy components - integer,parameter :: n_ene=21 - integer :: n_ene2=2*n_ene -!----------------------------------------------------------------------------- -! common.names -#ifndef WHAM_RUN -! common /namterm/ - character(len=10),dimension(n_ene) :: 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 "/) - character(len=10),dimension(n_ene) :: wname = & - (/"WSC ","WSCP ","WELEC ","WCORR ","WCORR5 ","WCORR6 ","WEL_LOC ",& - "WTURN3 ","WTURN4 ","WTURN6 ","WANG ","WSCLOC ","WTOR ","WTORD ",& - "WSTRAIN ","WVDWPP ","WBOND ","SCAL14 "," "," ","WSCCOR "/) - integer :: nprint_ene = 20 - integer,dimension(n_ene) :: print_order = & - (/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,21,0/) -#else - character(len=10),dimension(n_ene) :: 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 "/) - character(len=10),dimension(n_ene) :: wname = & - (/"WSC ","WSCP ","WELEC" ,"WCORR ","WCORR5 ","WCORR6 ","WEL_LOC ",& - "WTURN3 ","WTURN4 ","WTURN6 ","WANG ","WSCLOC ","WTOR ","WTORD ",& - "WHPB ","WVDWPP ","WSCP14 ","WBOND ","WSCCOR ","WDIHC ","WSC "/) - - integer :: nprint_ene = 21 - integer,dimension(n_ene) :: print_order = & - (/1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19,16,15,17,20,21/) -#endif -!----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- - end module names diff --git a/source/unres/prng.f90 b/source/unres/prng.f90 index 61df634..a3ced54 100644 --- a/source/unres/prng.f90 +++ b/source/unres/prng.f90 @@ -501,8 +501,8 @@ if (me .lt. 0 .or. me .gt. nmax) then prng_chkpnt=.false. else - prng_chkpnt=.true. - iseed=iparam(1,me) + prng_chkpnt=.true. + iseed=iparam(1,me) endif end function prng_chkpnt !----------------------------------------------------------------------------- @@ -527,10 +527,10 @@ if (me .lt. 0 .or. me .gt. nmax) then prng_restart=.false. - return + return else - prng_restart=.true. - iparam(1,me)=iseed + prng_restart=.true. + iparam(1,me)=iseed endif end function prng_restart !----------------------------------------------------------------------------- diff --git a/source/unres/prng_32.f90 b/source/unres/prng_32.f90 index 9807982..a991715 100644 --- a/source/unres/prng_32.f90 +++ b/source/unres/prng_32.f90 @@ -951,8 +951,8 @@ if (me .lt. 0 .or. me .gt. nmax) then prng_chkpnt=.false. else - prng_chkpnt=.true. - iseed=iparam(1,me) + prng_chkpnt=.true. + iseed=iparam(1,me) endif end function prng_chkpnt !----------------------------------------------------------------------------- @@ -979,10 +979,10 @@ if(me.gt.nmax) me=mod(me,nmax) if (me .lt. 0 .or. me .gt. nmax) then prng_restart=.false. - return + return else - prng_restart=.true. - iparam(1,me)=iseed + prng_restart=.true. + iparam(1,me)=iseed endif end function prng_restart !----------------------------------------------------------------------------- @@ -1016,7 +1016,7 @@ data m1,m2,m3,m4 / 0, 8037, 61950, 30779/ if (me .lt. 0 .or. me .gt. nmax) then prng_next=-1.0 - return + return endif l1=l(1,me) l2=l(2,me) @@ -1059,11 +1059,11 @@ 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) + 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 function prng_chkpnt @@ -1086,13 +1086,13 @@ !el common/ksrprng/l(16,0:nmax),n(16,0:nmax) if (me .lt. 0 .or. me .gt. nmax) then prng_restart=.false. - return + 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) + 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 function prng_restart diff --git a/source/unres/random.f90 b/source/unres/random.f90 index 61b3f14..fa14312 100644 --- a/source/unres/random.f90 +++ b/source/unres/random.f90 @@ -4,6 +4,7 @@ use prng ! prng.f90 or prng_32.f90 use math implicit none +! public :: rndv ! !----------------------------------------------------------------------------- contains @@ -85,7 +86,7 @@ data iset/0/ !elwrite(iout,*) "anorm distr start",x,sigma,alowb,aupb if(iset.eq.0) then -1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 + 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 @@ -138,27 +139,27 @@ ! enddo if (eig(1).lt.eig_limit) then print *,'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return + fail=.true. + return endif ! ! Generate points following the normal distributions along the principal ! axes of the moment matrix. Store in WORK. ! do i=1,n - sigma=1.0D0/dsqrt(eig(i)) - alim=-3.0D0*sigma - work(i)=anorm_distr(0.0D0,sigma,-alim,alim) + sigma=1.0D0/dsqrt(eig(i)) + alim=-3.0D0*sigma + work(i)=anorm_distr(0.0D0,sigma,-alim,alim) enddo ! ! Transform the vector of normal variables back to the original basis. ! do i=1,n - xi=0.0D0 - do j=1,n - xi=xi+a(i,j)*work(j) + xi=0.0D0 + do j=1,n + xi=xi+a(i,j)*work(j) enddo - x(i)=xi + x(i)=xi enddo return end subroutine mult_norm @@ -213,10 +214,10 @@ 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)) + 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) diff --git a/source/unres/regularize.f90 b/source/unres/regularize.f90 index 061cf44..0eb81e5 100644 --- a/source/unres/regularize.f90 +++ b/source/unres/regularize.f90 @@ -3,12 +3,12 @@ use io_units use geometry_data use energy_data -#ifndef WHAM_RUN +#if .not. defined WHAM_RUN && .not. defined CLUSTER use minim_data, only: maxfun,rtolf #endif implicit none contains -#ifndef WHAM_RUN +#if .not. defined WHAM_RUN && .not. defined CLUSTER !----------------------------------------------------------------------------- ! regularize.F !----------------------------------------------------------------------------- @@ -487,7 +487,7 @@ 10 c(i,j)=c(i,j)+a(i,k)*b(k,j) return end subroutine mmmul -#ifndef WHAM_RUN +#if .not. defined WHAM_RUN || .not. defined CLUSTER !----------------------------------------------------------------------------- subroutine matvec(uvec,tmat,pvec,nback) diff --git a/source/unres/unres.f90 b/source/unres/unres.f90 index f75675a..89feccc 100644 --- a/source/unres/unres.f90 +++ b/source/unres/unres.f90 @@ -68,7 +68,6 @@ text_mode_calc(13) = 'Not used 13' text_mode_calc(14) = 'Replica exchange molecular dynamics (REMD)' ! external ilen -!el run_wham=.false. ! call memmon_print_usage() call init_task @@ -164,6 +163,7 @@ use geometry, only:chainbuild use MDyn use io_units !include 'COMMON.IOUNITS' +! use io_common implicit none ! include 'DIMENSIONS' #ifdef MPI @@ -217,11 +217,13 @@ use control_data !include 'COMMON.CONTROL''COMMON.TIME1''COMMON.NAMES''COMMON.HEADER' use io_units !include 'COMMON.IOUNITS' use names -! use io_common ! use energy !include 'COMMON.INTERACT''COMMON.CONTACTS''COMMON.VAR''COMMON.FFIELD' 'COMMON.SBRIDGE' use geometry_data !include 'COMMON.GEO''COMMON.CHAIN' ! use REMD !include 'COMMON.REMD' ! use MD !include 'COMMON.MD' + + use energy_data + use io_base use geometry, only:chainbuild use energy @@ -245,21 +247,30 @@ integer,dimension(4,nres/3) :: iharp !(4,nres/3)(4,maxres/3) logical :: fail real(kind=8) :: rms,frac,frac_nn,co + + integer :: j,k call alloc_compare_arrays if (indpdb.eq.0) call chainbuild #ifdef MPI time00=MPI_Wtime() #endif call chainbuild_cart - +! write(iout,*)"in exec_eeval or minimim",split_ene +! do j=1,2*nres+2 +! write(iout,*)"cccccc",j,(c(i,j),i=1,3) +! write(iout,*)"dcccccc",j,(dc(i,j),i=1,3) +! enddo if (split_ene) then +! write(iout,*)"in exec_eeval or minimim" print *,"Processor",myrank," after chainbuild" icall=1 +!elwrite(iout,*)"in exec_eeval or minimim" call etotal_long(energy_long) write (iout,*) "Printing long range energy" call enerprint(energy_long) +!elwrite(iout,*)"in exec_eeval or minimim" call etotal_short(energy_short) write (iout,*) "Printing short range energy" @@ -273,6 +284,7 @@ endif call etotal(energy_) +!elwrite(iout,*)"after etotal in exec_eev" #ifdef MPI time_ene=MPI_Wtime()-time00 #endif @@ -281,13 +293,19 @@ etota = energy_(0) etot = etota call enerprint(energy_) +!write(iout,*)"after enerprint" call hairpin(.true.,nharp,iharp) +!write(iout,*) "after hairpin"!,hfrag(1,1) call secondary2(.true.) +!write(iout,*) "after secondary2" if (minim) then !rc overlap test +!elwrite(iout,*) "after secondary2 minim",minim if (overlapsc) then print *, 'Calling OVERLAP_SC' +!write(iout,*) 'Calling OVERLAP_SC' call overlap_sc(fail) +!write(iout,*) 'after Calling OVERLAP_SC' endif if (searchsc) then @@ -297,22 +315,32 @@ endif if (dccart) then +!write(iout,*) 'CART calling minim_dc', nvar print *, 'Calling MINIM_DC' #ifdef MPI time1=MPI_WTIME() #endif +! call check_ecartint !el call minim_dc(etot,iretcode,nfun) +! call check_ecartint !el else +!write(iout,*) "indpdb",indpdb if (indpdb.ne.0) then +!write(iout,*) 'if indpdb', indpdb call bond_regular call chainbuild endif call geom_to_var(nvar,varia) +!write(iout,*) 'po geom to var; calling minimize', nvar print *,'Calling MINIMIZE.' #ifdef MPI time1=MPI_WTIME() #endif +! call check_eint +! call exec_checkgrad !el call minimize(etot,varia,iretcode,nfun) +! call check_eint +! call exec_checkgrad !el endif print *,'SUMSL return code is',iretcode,' eval ',nfun #ifdef MPI @@ -333,12 +361,17 @@ write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals else +!elwrite(iout,*) "after secondary2 minim",minim print *,'refstr=',refstr if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) +!elwrite(iout,*) "rms_nac" +!elwrite(iout,*) "before briefout" call briefout(0,etot) +!elwrite(iout,*) "after briefout" endif if (outpdb) call pdbout(etot,titel(:32),ipdb) if (outmol2) call mol2out(etot,titel(:32)) +!elwrite(iout,*) "after exec_eeval_or_minim" return end subroutine exec_eeval_or_minim !----------------------------------------------------------------------------- @@ -349,7 +382,7 @@ use names use energy_data !include 'COMMON.INTERACT''COMMON.CONTACTS''COMMON.VAR''COMMON.FFIELD' 'COMMON.SBRIDGE' use geometry_data !include 'COMMON.GEO''COMMON.CHAIN' -! use REMD !include 'COMMON.REMD' + ! use REMD !include 'COMMON.REMD' ! use MD !include 'COMMON.MD' use regularize_ use compare @@ -806,6 +839,7 @@ end subroutine exec_checkgrad !----------------------------------------------------------------------------- subroutine exec_map +! use map_data use map_ use io_config, only:map_read implicit none @@ -820,6 +854,7 @@ use io_units !include 'COMMON.IOUNITS' use CSA + implicit none #ifdef MPI include "mpif.h" @@ -1007,13 +1042,9 @@ else if (iorder.eq.8) then call intcartderiv else if (iorder.eq.9) then -write(iout,*) "przed fricmat_mult" call fricmat_mult(z,d_a_tmp) -write(iout,*) "po fricmat_mult" else if (iorder.eq.10) then -write(iout,*) "przed setup_fricmat" call setup_fricmat -write(iout,*) "o setup_fricmat" endif enddo write (*,*) 'Processor',fg_rank,' CG group',kolor,& diff --git a/source/unres/xdrf b/source/unres/xdrf new file mode 120000 index 0000000..038166c --- /dev/null +++ b/source/unres/xdrf @@ -0,0 +1 @@ +../xdrf \ No newline at end of file diff --git a/source/wham/Makefile b/source/wham/Makefile new file mode 100644 index 0000000..a04735a --- /dev/null +++ b/source/wham/Makefile @@ -0,0 +1,181 @@ +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh + +#FC= ifort +OPT = -mcmodel=medium -O3 -ip -w + +FC= ${INSTALL_DIR}/bin/mpif90 +CC = gcc + +#DEB = -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +DEB = -g -CA -CB -check pointer #-check uninit +#OPT = -O3 #-ip +FFLAGS = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS2 = -fpp -c -g -CA -CB #-O0 +#FFLAGS = -c -g -C -I. -I./include_unres -I$(INSTALL_DIR)/include +#LIBS = -L$(INSTALL_DIR)/lib -lmpich ../../lib/xdrf/libxdrf.a + +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DWHAM_RUN -DMPI -DISNAN + +#EXE_FILE = ../bin/wham_F90_EL.exe +#UNRES_FILE= ../../UNRESS/unres_f90/source/unres_MD-M +UNRES_FILE= ../unres_MD-M +UNRES_DATA_FILE= ../unres_MD-M/data + +data = wham_data.o w_compar_data.o w_comm_local.o + +data_unres = names.o io_units.o calc_data.o compare_data.o control_data.o minim_data.o CSA_data.o\ + energy_data.o geometry_data.o MD_data.o MPI_data.o MCM_data.o comm_local.o + +objects_unres = xdrf/*.o math.o geometry.o \ + io_base.o energy.o control.o regularize.o compare.o + +objects = conform_compar.o io_database.o io_config.o io_wham.o\ + enecalc.o wham_calc.o work_partition.o\ + wham.o +#io_config is from unres package + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" + +no_option: + +GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM_RUN #-DWHAM +GAB: EXE_FILE = ../../bin/wham_GAB_F90_EL.exe +GAB: ${data} ${data_unres} ${objects_unres} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + $(FC) ${OPT} ${data} ${data_unres} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ +# ${LIBS} -static-intel -o ${BIN}/wham-mult_ifort_MPICH-GAB.exe + +4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM_RUN # -DWHAM +4P: EXE_FILE = ../../bin/wham_4P_F90_EL.exe +4P: ${data} ${data_unres} ${objects_unres} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + $(FC) ${OPT} ${data} ${data_unres} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ +# ${LIBS} -static-intel -o ${BIN}/wham-mult_ifort_MPICH_D-4P.exe + +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -DWHAM_RUN #-DWHAM +E0LL2Y: EXE_FILE = ../../bin/wham_E0LL2Y_F90_EL.exe +E0LL2Y: ${data} ${data_unres} ${objects_unres} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + $(FC) ${OPT} ${data} ${data_unres} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ +# ${LIBS} -static-intel -o ${BIN}/wham-mult_ifort_MPICH_D-E0LL2Y.exe + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm -f compinfo && cd xdrf && make clean +# rm -f *.o && rm -f *.mod && rm -f ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean +# /bin/rm *.o + +wham_data.o: wham_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham_data.f90 + +w_compar_data.o: w_compar_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} w_compar_data.f90 + +w_comm_local.o: w_comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} w_comm_local.f90 + + +names.o: ${UNRES_DATA_FILE}/names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/names.f90 + +io_units.o: ${UNRES_DATA_FILE}/io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/io_units.f90 + +calc_data.o: ${UNRES_DATA_FILE}/calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/calc_data.f90 + +compare_data.o: ${UNRES_DATA_FILE}/compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/compare_data.f90 + +control_data.o: ${UNRES_DATA_FILE}/control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/control_data.f90 + +CSA_data.o: ${UNRES_DATA_FILE}/CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/CSA_data.f90 + +energy_data.o: ${UNRES_DATA_FILE}/energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/energy_data.f90 + +geometry_data.o: ${UNRES_DATA_FILE}/geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/geometry_data.f90 + +MCM_data.o: ${UNRES_DATA_FILE}/MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/MCM_data.f90 + +MD_data.o: ${UNRES_DATA_FILE}/MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/MD_data.f90 + +minim_data.o: ${UNRES_DATA_FILE}/minim_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/minim_data.f90 + +MPI_data.o: ${UNRES_DATA_FILE}/MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/MPI_data.f90 + +comm_local.o: ${UNRES_DATA_FILE}/comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_DATA_FILE}/comm_local.f90 + +math.o: ${UNRES_FILE}/math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/math.f90 + +geometry.o: ${UNRES_FILE}/geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/geometry.f90 + +io_base.o: ${UNRES_FILE}/io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io_base.f90 + +energy.o: ${UNRES_FILE}/energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/energy.f90 + +control.o: ${UNRES_FILE}/control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/control.f90 + +io_config.o: ${UNRES_FILE}/io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} ${UNRES_FILE}/io_config.f90 + +regularize.o: ${UNRES_FILE}/regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/regularize.f90 + +compare.o: ${UNRES_FILE}/compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/compare.f90 + + +proc_proc.o: proc_proc.c + ${CC} ${CPPFLAGS} -O -c proc_proc.c + +io_database.o: io_database.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_database.f90 + +io_wham.o: io_wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_wham.f90 + +conform_compar.o: conform_compar.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} conform_compar.f90 + +enecalc.o: enecalc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} enecalc.f90 + +wham_calc.o: wham_calc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham_calc.f90 + +work_partition.o: work_partition.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} work_partition.f90 + +wham.o: wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham.f90 + diff --git a/source/wham/Makefile_old b/source/wham/Makefile_old new file mode 100644 index 0000000..18d6710 --- /dev/null +++ b/source/wham/Makefile_old @@ -0,0 +1,236 @@ +INSTALL_DIR = /users/software/mpich2-1.4.1p1_intel +#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh + +#FC= ifort +OPT = -mcmodel=medium -O3 -ip -w + +FC= ${INSTALL_DIR}/bin/mpif90 +CC = gcc + +#DEB = -g -CA -CB -auto -zero -traceback -u -check pointer -check uninit +DEB = -g -CA -CB -check pointer #-check uninit +#OPT = -O3 #-ip +FFLAGS = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGSE = -fpp -c ${DEB} #${OPT} #-I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS2 = -fpp -c -g -CA -CB #-O0 +#FFLAGS = -c -g -C -I. -I./include_unres -I$(INSTALL_DIR)/include +#LIBS = -L$(INSTALL_DIR)/lib -lmpich ../../lib/xdrf/libxdrf.a + +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DWHAM_RUN -DMPI -DISNAN + +#EXE_FILE = ../bin/wham_F90_EL.exe +#UNRES_FILE= ../../UNRESS/unres_f90/source/unres_MD-M +UNRES_FILE= ../unres_MD-M + +data = wham_data.o w_compar_data.o w_comm_local.o + +objects_unres = xdrf/*.o names.o io_units.o calc_data.o compare_data.o control_data.o minim_data.o CSA_data.o\ + energy_data.o geometry_data.o MD_data.o MPI_data.o MCM_data.o comm_local.o math.o geometry.o \ + io_base.o energy.o control.o regularize.o compare.o + +objects = conform_compar.o io_database.o io_config.o io_wham.o\ + enecalc.o wham_calc.o work_partition.o\ + wham.o +#io_config is from unres package + +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" + +no_option: + +GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM_RUN #-DWHAM +GAB: EXE_FILE = ../../bin/wham_GAB_F90_EL.exe +GAB: ${data} ${objects_unres} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + $(FC) ${OPT} ${data} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ +# ${LIBS} -static-intel -o ${BIN}/wham-mult_ifort_MPICH-GAB.exe + +4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM_RUN # -DWHAM +4P: EXE_FILE = ../../bin/wham_4P_F90_EL.exe +4P: ${data} ${objects_unres} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + $(FC) ${OPT} ${data} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ +# ${LIBS} -static-intel -o ${BIN}/wham-mult_ifort_MPICH_D-4P.exe + +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -DWHAM_RUN #-DWHAM +E0LL2Y: EXE_FILE = ../../bin/wham_E0LL2Y_F90_EL.exe +E0LL2Y: ${data} ${objects_unres} ${objects} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f90 + $(FC) ${OPT} ${data} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} +# $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ +# ${LIBS} -static-intel -o ${BIN}/wham-mult_ifort_MPICH_D-E0LL2Y.exe + + +#wham: ${data} ${objects_unres} ${objects} +# cc -o compinfo compinfo.c +# ./compinfo | true +# ${FC} ${FFLAGS} cinfo.f90 +# $(FC) ${OPT} ${data} ${objects_unres} ${objects} cinfo.o -o ${EXE_FILE} + +xdrf/*.o: + cd xdrf && make + +clean: + rm -f *.o && rm -f *.mod && rm -f compinfo && cd xdrf && make clean +# rm -f *.o && rm -f *.mod && rm -f ${EXE_FILE} && rm -f compinfo && cd xdrf && make clean +# /bin/rm *.o + +wham_data.o: wham_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham_data.f90 + +w_compar_data.o: w_compar_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} w_compar_data.f90 + +w_comm_local.o: w_comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} w_comm_local.f90 + + +names.o: ${UNRES_FILE}/names.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/names.f90 + +io_units.o: ${UNRES_FILE}/io_units.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io_units.f90 + +calc_data.o: ${UNRES_FILE}/calc_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/calc_data.f90 + +compare_data.o: ${UNRES_FILE}/compare_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/compare_data.f90 + +control_data.o: ${UNRES_FILE}/control_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/control_data.f90 + +CSA_data.o: ${UNRES_FILE}/CSA_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/CSA_data.f90 + +energy_data.o: ${UNRES_FILE}/energy_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/energy_data.f90 + +geometry_data.o: ${UNRES_FILE}/geometry_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/geometry_data.f90 + +map_data.o: ${UNRES_FILE}/map_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/map_data.f90 + +MCM_data.o: ${UNRES_FILE}/MCM_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MCM_data.f90 + +MD_data.o: ${UNRES_FILE}/MD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MD_data.f90 + +minim_data.o: ${UNRES_FILE}/minim_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/minim_data.f90 + +MPI_data.o: ${UNRES_FILE}/MPI_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MPI_data.f90 + +REMD_data.o: ${UNRES_FILE}/REMD_data.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/REMD_data.f90 + +comm_local.o: ${UNRES_FILE}/comm_local.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/comm_local.f90 + +prng_32.o: ${UNRES_FILE}/prng_32.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/prng_32.f90 + +math.o: ${UNRES_FILE}/math.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/math.f90 + +random.o: ${UNRES_FILE}/random.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/random.f90 + +geometry.o: ${UNRES_FILE}/geometry.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/geometry.f90 + +md_calc.o: ${UNRES_FILE}/md_calc.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} ${UNRES_FILE}/md_calc.f90 + +io_base.o: ${UNRES_FILE}/io_base.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io_base.f90 + +energy.o: ${UNRES_FILE}/energy.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/energy.f90 + +check_bond.o: ${UNRES_FILE}/check_bond.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/check_bond.f90 + +control.o: ${UNRES_FILE}/control.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/control.f90 + +io_config.o: ${UNRES_FILE}/io_config.f90 + ${FC} ${FFLAGS2} ${CPPFLAGS} ${UNRES_FILE}/io_config.f90 + +MPI.o: ${UNRES_FILE}/MPI.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MPI.f90 + +minim.o: ${UNRES_FILE}/minim.f90 + ${FC} ${FFLAGS1} ${CPPFLAGS} ${UNRES_FILE}/minim.f90 + +regularize.o: ${UNRES_FILE}/regularize.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/regularize.f90 + +compare.o: ${UNRES_FILE}/compare.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/compare.f90 + +map.o: ${UNRES_FILE}/map.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/map.f90 + +muca_md.o: ${UNRES_FILE}/muca_md.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/muca_md.f90 + +REMD.o: ${UNRES_FILE}/REMD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/REMD.f90 + +MCM_MD.o: ${UNRES_FILE}/MCM_MD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MCM_MD.f90 + +io.o: ${UNRES_FILE}/io.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/io.f90 + +MD.o: ${UNRES_FILE}/MD.f90 + ${FC} ${FFLAGSE} ${CPPFLAGS} ${UNRES_FILE}/MD.f90 + +MREMD.o: ${UNRES_FILE}/MREMD.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/MREMD.f90 + +CSA.o: ${UNRES_FILE}/CSA.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/CSA.f90 + +unres.o: ${UNRES_FILE}/unres.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} ${UNRES_FILE}/unres.f90 + + +proc_proc.o: proc_proc.c + ${CC} ${CPPFLAGS} -O -c proc_proc.c + +io_database.o: io_database.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_database.f90 + +io_wham.o: io_wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} io_wham.f90 + +conform_compar.o: conform_compar.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} conform_compar.f90 + +enecalc.o: enecalc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} enecalc.f90 + +wham_calc.o: wham_calc.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham_calc.f90 + +work_partition.o: work_partition.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} work_partition.f90 + +wham.o: wham.f90 + ${FC} ${FFLAGS} ${CPPFLAGS} wham.f90 + diff --git a/source/wham/cinfo.f90 b/source/wham/cinfo.f90 new file mode 100644 index 0000000..7d9a4d1 --- /dev/null +++ b/source/wham/cinfo.f90 @@ -0,0 +1,38 @@ +! DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C +! 0 0 1254 + subroutine cinfo +! include 'COMMON.IOUNITS' + use IO_UNITS + write(iout,*)'++++ Compile info ++++' + write(iout,*)'Version 0.0 build 1254' + write(iout,*)'compiled Fri Oct 14 14:37:13 2016' + write(iout,*)'compiled by emilial@piasek4' + write(iout,*)'OS name: Linux ' + write(iout,*)'OS release: 3.2.0-111-generic ' + write(iout,*)'OS version:',& + ' #153-Ubuntu SMP Wed Sep 21 21:23:31 UTC 2016 ' + write(iout,*)'flags:' + write(iout,*)'INSTALL_DIR = /users/software/mpich2-1.4.1p1_in...' + write(iout,*)'OPT = -mcmodel=medium -O3 -ip -w' + write(iout,*)'FC= ${INSTALL_DIR}/bin/mpif90' + write(iout,*)'CC = gcc' + write(iout,*)'DEB = -g -CA -CB -check pointer #-check uninit' + write(iout,*)'FFLAGS = -fpp -c ${DEB} #${OPT} #-I. -I./includ...' + write(iout,*)'FFLAGSE = -fpp -c ${DEB} #${OPT} #-I. -I./inclu...' + write(iout,*)'FFLAGS2 = -fpp -c -g -CA -CB #-O0' + write(iout,*)'UNRES_FILE= ../unres_MD-M' + write(iout,*)'UNRES_DATA_FILE= ../unres_MD-M/data' + write(iout,*)'data = wham_data.o w_compar_data.o w_comm_local.o' + write(iout,*)'data_unres = names.o io_units.o calc_data.o com...' + write(iout,*)'objects_unres = xdrf/*.o math.o geometry.o \\' + write(iout,*)' io_base.o energy.o control.o regularize.o comp...' + write(iout,*)'objects = conform_compar.o io_database.o io_con...' + write(iout,*)'GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITEL...' + write(iout,*)'GAB: EXE_FILE = ../../bin/wham_GAB_F90_EL.exe' + write(iout,*)'4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE...' + write(iout,*)'4P: EXE_FILE = ../../bin/wham_4P_F90_EL.exe' + write(iout,*)'E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLI...' + write(iout,*)'E0LL2Y: EXE_FILE = ../../bin/wham_E0LL2Y_F90_EL...' + write(iout,*)'++++ End of compile info ++++' + return + end diff --git a/source/wham/compinfo.c b/source/wham/compinfo.c new file mode 100644 index 0000000..2bda4c3 --- /dev/null +++ b/source/wham/compinfo.c @@ -0,0 +1,82 @@ +#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.f90","r"); +out=fopen("cinfo.f90.new","w"); +if (fgets(buf,498,in) != NULL) + fprintf(out,"! 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,"! %d %d %d\n",iv1,iv2,iv3); +fprintf(out," subroutine cinfo\n"); +fprintf(out,"! include 'COMMON.IOUNITS'\n"); +fprintf(out," use IO_UNITS\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(in); +system("mv cinfo.f90.new cinfo.f90"); +} diff --git a/source/wham/conform_compar.f90 b/source/wham/conform_compar.f90 new file mode 100644 index 0000000..e983f7f --- /dev/null +++ b/source/wham/conform_compar.f90 @@ -0,0 +1,3559 @@ + module conform_compar +!----------------------------------------------------------------------------- + use names + use io_units + use geometry_data, only:nres + use math, only:pinorm + use geometry, only:dist + use regularize_, only:fitsq +! + use wham_data +#ifndef CLUSTER + use w_compar_data +#endif +#ifdef MPI + use MPI_data +! include "COMMON.MPI" +#endif + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +#ifndef CLUSTER +!----------------------------------------------------------------------------- +! conf_compar.F +!----------------------------------------------------------------------------- + subroutine conf_compar(jcon,lprn,print_class) +! implicit real*8 (a-h,o-z) + use energy_data, only:icont,ncont,nnt,nct,maxcont!,& +! nsccont_frag_ref,isccont_frag_ref +#ifdef MPI + include "mpif.h" +#endif +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'DIMENSIONS.FREE' +! include 'COMMON.CONTROL' +! include 'COMMON.IOUNITS' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.PEPTCONT' +! include 'COMMON.CONTACTS1' +! include 'COMMON.HEADER' +! include 'COMMON.FREE' +! include 'COMMON.ENERGIES' +!#ifdef MPI +! include 'COMMON.MPI' +!#endif +! integer ilen +! external ilen + logical :: lprn,print_class + integer :: ncont_frag(mmaxfrag),& + icont_frag(2,maxcont,mmaxfrag),ncontsc,& + icontsc(1,maxcont),nsccont_frag(mmaxfrag),& + isccont_frag(2,maxcont,mmaxfrag) + integer :: isecstr(nres) + integer :: itemp(maxfrag) + character(len=4) :: liczba + real(kind=8) :: Epot,rms + integer :: jcon,i,j,ind,ncnat,nsec_match,ishift,ishif1,ishif2,& + nc_match,ncon_match,iclass_rms,ishifft_rms,ishiff,ishif + integer :: k,kk,iclass_con,iscor,ik,ishifft_con,idig,iex,im +! print *,"Enter conf_compar",jcon + call angnorm12(rmsang) +! Level 1: check secondary and supersecondary structure + call elecont(lprn,ncont,icont,nnt,nct) + if (lprn) then + write (iout,*) "elecont finished" + call flush(iout) + endif + call secondary2(lprn,.false.,ncont,icont,isecstr) + if (lprn) then + write (iout,*) "secondary2 finished" + call flush(iout) + endif + call contact(lprn,ncontsc,icontsc,nnt,nct) + if (lprn) then + write(iout,*) "Assigning electrostatic contacts" + call flush(iout) + endif + call contacts_between_fragments(lprn,3,ncont,icont,ncont_frag,& + icont_frag) + if (lprn) then + write(iout,*) "Assigning sidechain contacts" + call flush(iout) + endif + call contacts_between_fragments(lprn,3,ncontsc,icontsc,& + nsccont_frag,isccont_frag) + if (lprn) then + write(iout,*) "--> After contacts_between_fragments" + call flush(iout) + endif + do i=1,nlevel + do j=1,isnfrag(nlevel+1) + iclass(j,i)=0 + enddo + enddo + do j=1,nfrag(1) + ind = icant(j,j) + if (lprn) then + write (iout,'(80(1h=))') + write (iout,*) "Level",1," fragment",j + write (iout,'(80(1h=))') + endif + call flush(iout) + rmsfrag(j,1)=rmscalc(0,1,j,jcon,lprn) +! Compare electrostatic contacts in the current conf with that in the native +! structure. + if (lprn) write (iout,*) & + "Comparing electrostatic contact map and local structure" + call flush(iout) + ncnat=ncont_frag_ref(ind) +! write (iout,*) "before match_contact:",nc_fragm(j,1), +! & nc_req_setf(j,1) +! call flush(iout) + call match_secondary(j,isecstr,nsec_match,lprn) + if (lprn) write (iout,*) "Fragment",j," nsec_match",& + nsec_match," length",len_frag(j,1)," min_len",& + frac_sec*len_frag(j,1) + if (nsec_match.lt.frac_sec*len_frag(j,1)) then + iclass(j,1)=0 + if (lprn) write (iout,*) "Fragment",j,& + " has incorrect secondary structure" + else + iclass(j,1)=1 + if (lprn) write (iout,*) "Fragment",j,& + " has correct secondary structure" + endif + if (ielecont(j,1).gt.0) then + call match_contact(ishif1,ishif2,nc_match,ncon_match,& + ncont_frag_ref(ind),icont_frag_ref(1,1,ind),& + ncont_frag(ind),icont_frag(1,1,ind),& + j,n_shift(1,j,1),n_shift(2,j,1),nc_fragm(j,1),& + nc_req_setf(j,1),istruct(j),.true.,lprn) + else if (isccont(j,1).gt.0) then + call match_contact(ishif1,ishif2,nc_match,ncon_match,& + nsccont_frag_ref(ind),isccont_frag_ref(1,1,ind),& + nsccont_frag(ind),isccont_frag(1,1,ind),& + j,n_shift(1,j,1),n_shift(2,j,1),nc_fragm(j,1),& + nc_req_setf(j,1),istruct(j),.true.,lprn) + else if (iloc(j).gt.0) then +! write (iout,*) "n_shif",n_shift(1,j,1),n_shift(2,j,1) + call match_contact(ishif1,ishif2,nc_match,ncon_match,& + 0,icont_frag_ref(1,1,ind),& + ncont_frag(ind),icont_frag(1,1,ind),& + j,n_shift(1,j,1),n_shift(2,j,1),nc_fragm(j,1),& + 0,istruct(j),.true.,lprn) +! write (iout,*) "n_shif",n_shift(1,j,1),n_shift(2,j,1) + else + ishif=0 + nc_match=1 + endif + if (lprn) write (iout,*) "ishif1",ishif1," ishif2",ishif2 + ishif=ishif1 + qfrag(j,1)=qwolynes(1,j) + if (iabs(ishif2).gt.iabs(ishif1)) ishif=ishif2 + if (lprn) write (iout,*) "ishift",ishif," nc_match",nc_match +! write (iout,*) "j",j," ishif",ishif," rms",rmsfrag(j,1) + if (irms(j,1).gt.0) then + if (rmsfrag(j,1).le.rmscutfrag(1,j,1)) then + iclass_rms=2 + ishifft_rms=0 + else + ishiff=0 + rms=1.0d2 + iclass_rms=0 + do while (rms.gt.rmscutfrag(1,j,1) .and. & + ishiff.lt.n_shift(1,j,1)) + ishiff=ishiff+1 + rms=rmscalc(-ishiff,1,j,jcon,lprn) +! write(iout,*)"jcon,i,j,ishiff",jcon,i,j,-ishiff, +! & " 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(ishiff,1,j,jcon,lprn) +! write (iout,*) "jcon,1,j,ishiff",jcon,1,j,ishiff, +! & " rms",rms + endif + if (lprn) write (iout,*) "rms",rmsfrag(j,1) + enddo +! write (iout,*) "After loop: rms",rms, +! & " rmscut",rmscutfrag(1,j,1) +! write (iout,*) "iclass_rms",iclass_rms + if (rms.le.rmscutfrag(1,j,1)) then + ishifft_rms=ishiff + rmsfrag(j,1)=rms + iclass_rms=1 + endif +! write (iout,*) "iclass_rms",iclass_rms + endif +! write (iout,*) "ishif",ishif + if (iabs(ishifft_rms).gt.iabs(ishif)) ishif=ishifft_rms + else + iclass_rms=1 + endif +! write (iout,*) "ishif",ishif," iclass",iclass(j,1), +! & " iclass_rms",iclass_rms + if (nc_match.gt.0 .and. iclass_rms.gt.0) then + if (ishif.eq.0) then + iclass(j,1)=iclass(j,1)+6 + else + iclass(j,1)=iclass(j,1)+2 + endif + endif + ncont_nat(1,j,1)=nc_match + ncont_nat(2,j,1)=ncon_match + ishifft(j,1)=ishif +! write (iout,*) "iclass",iclass(j,1) + enddo +! Next levels: Check arrangements of elementary fragments. + do i=2,nlevel + do j=1,nfrag(i) + if (i .eq. 2) ind = icant(ipiece(1,j,i),ipiece(2,j,i)) + if (lprn) then + write (iout,'(80(1h=))') + write (iout,*) "Level",i," fragment",j + write (iout,'(80(1h=))') + endif +! If an elementary fragment doesn't exist, don't check higher hierarchy levels. + do k=1,npiece(j,i) + ik=ipiece(k,j,i) + if (iclass(ik,1).eq.0) then + iclass(j,i)=0 + goto 12 + endif + enddo + if (i.eq.2 .and. ielecont(j,i).gt.0) then + iclass_con=0 + ishifft_con=0 + if (lprn) write (iout,*) & + "Comparing electrostatic contact map: fragments",& + ipiece(1,j,i),ipiece(2,j,i)," ind",ind + call match_contact(ishif1,ishif2,nc_match,ncon_match,& + ncont_frag_ref(ind),icont_frag_ref(1,1,ind),& + ncont_frag(ind),icont_frag(1,1,ind),& + j,n_shift(1,j,i),n_shift(2,j,i),nc_fragm(j,i),& + nc_req_setf(j,i),2,.false.,lprn) + ishif=ishif1 + if (iabs(ishif2).gt.iabs(ishif1)) ishif=ishif2 + if (nc_match.gt.0) then + if (ishif.eq.0) then + iclass_con=2 + else + iclass_con=1 + endif + endif + ncont_nat(1,j,i)=nc_match + ncont_nat(2,j,i)=ncon_match + ishifft_con=ishif + else if (i.eq.2 .and. isccont(j,i).gt.0) then + iclass_con=0 + ishifft_con=0 + if (lprn) write (iout,*) & + "Comparing sidechain contact map: fragments",& + ipiece(1,j,i),ipiece(2,j,i)," ind",ind + call match_contact(ishif1,ishif2,nc_match,ncon_match,& + nsccont_frag_ref(ind),isccont_frag_ref(1,1,ind),& + nsccont_frag(ind),isccont_frag(1,1,ind),& + j,n_shift(1,j,i),n_shift(2,j,i),nc_fragm(j,i),& + nc_req_setf(j,i),2,.false.,lprn) + ishif=ishif1 + if (iabs(ishif2).gt.iabs(ishif1)) ishif=ishif2 + if (nc_match.gt.0) then + if (ishif.eq.0) then + iclass_con=2 + else + iclass_con=1 + endif + endif + ncont_nat(1,j,i)=nc_match + ncont_nat(2,j,i)=ncon_match + ishifft_con=ishif + else if (i.eq.2) then + iclass_con=2 + ishifft_con=0 + endif + if (i.eq.2) qfrag(j,2)=qwolynes(2,j) + if (lprn) write (iout,*) & + "Comparing rms: fragments",& + (ipiece(k,j,i),k=1,npiece(j,i)) + rmsfrag(j,i)=rmscalc(0,i,j,jcon,lprn) + if (irms(j,i).gt.0) then + iclass_rms=0 + ishifft_rms=0 + if (lprn) write (iout,*) "rms",rmsfrag(j,i) +! write (iout,*) "i",i," j",j," rmsfrag",rmsfrag(j,i), +! & " rmscutfrag",rmscutfrag(1,j,i) + if (rmsfrag(j,i).le.rmscutfrag(1,j,i)) then + iclass_rms=2 + ishifft_rms=0 + else + ishif=0 + rms=1.0d2 + do while (rms.gt.rmscutfrag(1,j,i) .and. & + ishif.lt.n_shift(1,j,i)) + ishif=ishif+1 + rms=rmscalc(-ishif,i,j,jcon,lprn) +! 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(ishif,i,j,jcon,lprn) +! print *,"jcon,i,j,ishif",jcon,i,j,ishif," rms",rms + endif + if (lprn) write (iout,*) "rms",rms + enddo + if (rms.le.rmscutfrag(1,j,i)) then + ishifft_rms=ishif + rmsfrag(j,i)=rms + iclass_rms=1 + endif + endif + endif + if (irms(j,i).eq.0 .and. ielecont(j,i).eq.0 .and. & + isccont(j,i).eq.0 ) then + write (iout,*) "Error: no measure of comparison specified:",& + " level",i," part",j + stop + endif + if (lprn) & + write (iout,*) "iclass_con",iclass_con," iclass_rms",iclass_rms + if (i.eq.2) then + iclass(j,i) = min0(iclass_con,iclass_rms) + if (iabs(ishifft_rms).gt.iabs(ishifft_con)) then + ishifft(j,i)=ishifft_rms + else + ishifft(j,i)=ishifft_con + endif + else if (i.gt.2) then + iclass(j,i) = iclass_rms + ishifft(j,i)= ishifft_rms + endif + 12 continue + enddo + enddo + rms_nat=rmsnat(jcon) + qnat=qwolynes(0,0) +! Compute the structural class + iscor=0 + IF (.NOT. BINARY) THEN + do i=1,nlevel + IF (I.EQ.1) THEN + do j=1,nfrag(i) + itemp(j)=iclass(j,i) + enddo + do kk=-1,1 + do j=1,nfrag(i) + idig = 2*isnfrag(nlevel+1)-2*isnfrag(i)-kk*nfrag(i)-j + iex = 2**idig + im=mod(itemp(j),2) + itemp(j)=itemp(j)/2 +! write (iout,*) "i",i," j",j," idig",idig," iex",iex, +! & " iclass",iclass(j,i)," im",im + iscor=iscor+im*iex + enddo + enddo + ELSE + do j=1,nfrag(i) + idig = 2*isnfrag(nlevel+1)-2*isnfrag(i)-j + iex = 2**idig + if (iclass(j,i).gt.0) then + im=1 + else + im=0 + endif +! write (iout,*) "i",i," j",j," idig",idig," iex",iex, +! & " iclass",iclass(j,i)," im",im + iscor=iscor+im*iex + enddo + do j=1,nfrag(i) + idig = 2*isnfrag(nlevel+1)-2*isnfrag(i)-nfrag(i)-j + iex = 2**idig + if (iclass(j,i).gt.1) then + im=1 + else + im=0 + endif +! write (iout,*) "i",i," j",j," idig",idig," iex",iex, +! & " iclass",iclass(j,i)," im",im + iscor=iscor+im*iex + enddo + ENDIF + enddo + iscore=iscor + ENDIF + if (print_class) then +#ifdef MPI + write(istat,'(i6,$)') jcon+indstart(me)-1 + write (istat,'(f10.2,$)') (potE(jcon,k),k=1,nParmSet),& + -entfac(jcon) +#else + write(istat,'(i6,$)') jcon + write (istat,'(f10.2,$)') (potE(jcon,k),k=1,nParmSet),& + -entfac(jcon) +#endif + write (istat,'(f8.3,2f6.3,$)') & + rms_nat,qnat,rmsang/(nres-3) + do j=1,nlevel + write(istat,'(1x,$,20(i3,$))') & + (ncont_nat(1,k,j),k=1,nfrag(j)) + if (j.lt.3) then + write(istat,'(1x,$,20(f5.1,f5.2$))') & + (rmsfrag(k,j),qfrag(k,j),k=1,nfrag(j)) + else + write(istat,'(1x,$,20(f5.1$))') & + (rmsfrag(k,j),k=1,nfrag(j)) + endif + write(istat,'(1x,$,20(i1,$))') & + (iclass(k,j),k=1,nfrag(j)) + enddo + if (binary) then + write (istat,'(" ",$)') + do j=1,nlevel + write (istat,'(100(i1,$))')(iclass(k,j),& + k=1,nfrag(j)) + if (j.lt.nlevel) write(iout,'(".",$)') + enddo + write (istat,*) + else + write (istat,'(i10)') iscore + endif + endif + RETURN + END subroutine conf_compar +!----------------------------------------------------------------------------- +! angnorm.f +!----------------------------------------------------------------------------- + subroutine add_angpair(ici,icj,nang_pair,iang_pair) + +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' + integer :: ici,icj,nang_pair,iang_pair(2,nres) + integer :: i,ian1,ian2 +! write (iout,*) "add_angpair: ici",ici," icj",icj, +! & " nang_pair",nang_pair + ian1=ici+2 + if (ian1.lt.4 .or. ian1.gt.nres) return + ian2=icj+2 +! write (iout,*) "ian1",ian1," ian2",ian2 + if (ian2.lt.4 .or. ian2.gt.nres) return + do i=1,nang_pair + if (ian1.eq.iang_pair(1,i) .and. ian2.eq.iang_pair(2,i)) return + enddo + nang_pair=nang_pair+1 + iang_pair(1,nang_pair)=ian1 + iang_pair(2,nang_pair)=ian2 + return + end subroutine add_angpair +!------------------------------------------------------------------------- + subroutine angnorm(jfrag,ishif1,ishif2,diffang_max,angn,fract,lprn) + + use geometry_data, only:nstart_sup,nend_sup,phi,theta,& + rad2deg,dwapi +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.VAR' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.GEO' + real(kind=8) :: pinorm,deltang + logical :: lprn + integer :: jfrag,ishif1,ishif2,nn,npart,nn4,nne + real(kind=8) :: diffang_max,angn,fract,ff + integer :: i,j,nbeg,nend,ll,longest + if (lprn) write (iout,'(80(1h*))') + angn=0.0d0 + nn = 0 + fract = 1.0d0 + npart = npiece(jfrag,1) + nn4 = nstart_sup+3 + nne = min0(nend_sup,nres) + if (lprn) write (iout,*) "nn4",nn4," nne",nne + do i=1,npart + nbeg = ifrag(1,i,jfrag) + 3 - ishif1 + if (nbeg.lt.nn4) nbeg=nn4 + nend = ifrag(2,i,jfrag) + 1 - ishif2 + if (nend.gt.nne) nend=nne + if (nend.ge.nbeg) then + nn = nn + nend - nbeg + 1 + if (lprn) write (iout,*) "i=",i," nbeg",nbeg," nend",nend,& + " nn",nn," ishift1",ishif1," ishift2",ishif2 + if (lprn) write (iout,*) "angles" + longest=0 + ll = 0 + do j=nbeg,nend +! deltang = pinorm(phi(j)-phi_ref(j+ishif1)) + deltang=spherang(phi_ref(j+ishif1),theta_ref(j-1+ishif1),& + theta_ref(j+ishif1),phi(j),theta(j-1),theta(j)) + if (dabs(deltang).gt.diffang_max) then + if (ll.gt.longest) longest = ll + ll = 0 + else + ll=ll+1 + endif + if (ll.gt.longest) longest = ll + if (lprn) write (iout,'(i5,3f10.5)')j,rad2deg*phi(j),& + rad2deg*phi_ref(j+ishif1),rad2deg*deltang + angn=angn+dabs(deltang) + enddo + longest=longest+3 + ff = dfloat(longest)/dfloat(nend - nbeg + 4) + if (lprn) write (iout,*)"segment",i," longest fragment within",& + diffang_max*rad2deg,":",longest," fraction",ff + if (ff.lt.fract) fract = ff + endif + enddo + if (nn.gt.0) then + angn = angn/nn + else + angn = dwapi + endif + if (lprn) write (iout,*) "nn",nn," norm",rad2deg*angn,& + " fract",fract + return + end subroutine angnorm +!------------------------------------------------------------------------- + subroutine angnorm2(jfrag,ishif1,ishif2,ncont,icont,lprn,& + diffang_max,anorm,fract) + + use geometry_data, only:nstart_sup,nend_sup,phi,theta,& + rad2deg +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.VAR' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.GEO' + integer :: ncont,icont(2,ncont),longest + real(kind=8) :: anorm,diffang_max,fract + integer :: npiece_c,ifrag_c(2,maxpiece),ishift_c(maxpiece) + real(kind=8) :: pinorm + logical :: lprn + integer :: jfrag,ishif1,ishif2 + integer :: nn,nn4,nne,npart,i,j,jstart,jend,ic1,ic2,idi,iic + integer :: nbeg,nend,ll + real(kind=8) :: angn,ishifc,deltang,ff + + if (lprn) write (iout,'(80(1h*))') +! +! Determine the segments for which angles will be compared +! + nn4 = nstart_sup+3 + nne = min0(nend_sup,nres) + if (lprn) write (iout,*) "nn4",nn4," nne",nne + npart=npiece(jfrag,1) + npiece_c=0 + do i=1,npart +! write (iout,*) "i",i," ifrag",ifrag(1,i,jfrag),ifrag(2,i,jfrag) + if (icont(1,ncont).lt.ifrag(1,i,jfrag) .or. & + icont(1,1).gt.ifrag(2,i,jfrag)) goto 11 + jstart=1 + do while (jstart.lt.ncont .and. & + icont(1,jstart).lt.ifrag(1,i,jfrag)) +! write (iout,*) "jstart",jstart," icont",icont(1,jstart), +! & " ifrag",ifrag(1,i,jfrag) + jstart=jstart+1 + enddo +! write (iout,*) "jstart",jstart," icont",icont(1,jstart), +! & " ifrag",ifrag(1,i,jfrag) + if (icont(1,jstart).lt.ifrag(1,i,jfrag)) goto 11 + npiece_c=npiece_c+1 + ic1=icont(1,jstart) + ifrag_c(1,npiece_c)=icont(1,jstart) + jend=ncont + do while (jend.gt.1 .and. icont(1,jend).gt.ifrag(2,i,jfrag)) +! write (iout,*) "jend",jend," icont",icont(1,jend), +! & " ifrag",ifrag(2,i,jfrag) + jend=jend-1 + enddo +! write (iout,*) "jend",jend," icont",icont(1,jend), +! & " ifrag",ifrag(2,i,jfrag) + ic2=icont(1,jend) + ifrag_c(2,npiece_c)=icont(1,jend)+1 + ishift_c(npiece_c)=ishif1 +! write (iout,*) "1: i",i," jstart:",jstart," jend",jend, +! & " ic1",ic1," ic2",ic2, +! & " ifrag",ifrag(1,i,jfrag),ifrag(2,i,jfrag) + 11 continue + if (ncont.eq.1 .or. icont(2,ncont).gt.icont(2,1)) then + idi=1 + else + idi=-1 + endif +! write (iout,*) "idi",idi + if (idi.eq.1) then + if (icont(2,1).gt.ifrag(2,i,jfrag) .or. & + icont(2,ncont).lt.ifrag(1,i,jfrag)) goto 12 + jstart=1 + do while (jstart.lt.ncont .and. & + icont(2,jstart).lt.ifrag(1,i,jfrag)) +! write (iout,*) "jstart",jstart," icont",icont(2,jstart), +! & " ifrag",ifrag(1,i,jfrag) + jstart=jstart+1 + enddo +! write (iout,*) "jstart",jstart," icont",icont(2,jstart), +! & " ifrag",ifrag(1,i,jfrag) + if (icont(2,jstart).lt.ifrag(1,i,jfrag)) goto 12 + npiece_c=npiece_c+1 + ic1=icont(2,jstart) + ifrag_c(2,npiece_c)=icont(2,jstart)+1 + jend=ncont + do while (jend.gt.1 .and. icont(2,jend).gt.ifrag(2,i,jfrag)) +! write (iout,*) "jend",jend," icont",icont(2,jend), +! & " ifrag",ifrag(2,i,jfrag) + jend=jend-1 + enddo +! write (iout,*) "jend",jend," icont",icont(2,jend), +! & " ifrag",ifrag(2,i,jfrag) + else if (idi.eq.-1) then + if (icont(2,ncont).gt.ifrag(2,i,jfrag) .or. & + icont(2,1).lt.ifrag(1,i,jfrag)) goto 12 + jstart=ncont + do while (jstart.gt.ncont .and. & + icont(2,jstart).lt.ifrag(1,i,jfrag)) +! write (iout,*) "jstart",jstart," icont",icont(2,jstart), +! & " ifrag",ifrag(1,i,jfrag) + jstart=jstart-1 + enddo +! write (iout,*) "jstart",jstart," icont",icont(2,jstart), +! & " ifrag",ifrag(1,i,jfrag) + if (icont(2,jstart).lt.ifrag(1,i,jfrag)) goto 12 + npiece_c=npiece_c+1 + ic1=icont(2,jstart) + ifrag_c(2,npiece_c)=icont(2,jstart)+1 + jend=1 + do while (jend.lt.ncont .and. & + icont(2,jend).gt.ifrag(2,i,jfrag)) +! write (iout,*) "jend",jend," icont",icont(2,jend), +! & " ifrag",ifrag(2,i,jfrag) + jend=jend+1 + enddo +! write (iout,*) "jend",jend," icont",icont(2,jend), +! & " ifrag",ifrag(2,i,jfrag) + endif + ic2=icont(2,jend) + if (ic2.lt.ic1) then + iic = ic1 + ic1 = ic2 + ic2 = iic + endif +! write (iout,*) "2: i",i," ic1",ic1," ic2",ic2, +! & " jstart:",jstart," jend",jend, +! & " ifrag",ifrag(1,i,jfrag),ifrag(2,i,jfrag) + ifrag_c(1,npiece_c)=ic1 + ifrag_c(2,npiece_c)=ic2+1 + ishift_c(npiece_c)=ishif2 + 12 continue + enddo + if (lprn) then + write (iout,*) "Before merge: npiece_c",npiece_c + do i=1,npiece_c + write (iout,*) ifrag_c(1,i),ifrag_c(2,i),ishift_c(i) + enddo + endif +! +! Merge overlapping segments (e.g., avoid splitting helices) +! + i=1 + do while (i .lt. npiece_c) + if (ishift_c(i).eq.ishift_c(i+1) .and. & + ifrag_c(2,i).gt.ifrag_c(1,i+1)) then + ifrag_c(2,i)=ifrag_c(2,i+1) + do j=i+1,npiece_c + ishift_c(j)=ishift_c(j+1) + ifrag_c(1,j)=ifrag_c(1,j+1) + ifrag_c(2,j)=ifrag_c(2,j+1) + enddo + npiece_c=npiece_c-1 + else + i=i+1 + endif + enddo + if (lprn) then + write (iout,*) "After merge: npiece_c",npiece_c + do i=1,npiece_c + write (iout,*) ifrag_c(1,i),ifrag_c(2,i),ishift_c(i) + enddo + endif +! +! Compare angles +! + angn=0.0d0 + anorm=0 + nn = 0 + fract = 1.0d0 + npart = npiece_c + do i=1,npart + ishifc=ishift_c(i) + nbeg = ifrag_c(1,i) + 3 - ishifc + if (nbeg.lt.nn4) nbeg=nn4 + nend = ifrag_c(2,i) - ishifc + 1 + if (nend.gt.nne) nend=nne + if (nend.ge.nbeg) then + nn = nn + nend - nbeg + 1 + if (lprn) write (iout,*) "i=",i," nbeg",nbeg," nend",nend,& + " nn",nn," ishifc",ishifc + if (lprn) write (iout,*) "angles" + longest=0 + ll = 0 + do j=nbeg,nend +! deltang = pinorm(phi(j)-phi_ref(j+ishifc)) + deltang=spherang(phi_ref(j+ishifc),theta_ref(j-1+ishifc),& + theta_ref(j+ishifc),phi(j),theta(j-1),theta(j)) + if (dabs(deltang).gt.diffang_max) then + if (ll.gt.longest) longest = ll + ll = 0 + else + ll=ll+1 + endif + if (ll.gt.longest) longest = ll + if (lprn) write (iout,'(i5,3f10.5)')j,rad2deg*phi(j),& + rad2deg*phi_ref(j+ishifc),rad2deg*deltang + angn=angn+dabs(deltang) + enddo + longest=longest+3 + ff = dfloat(longest)/dfloat(nend - nbeg + 4) + if (lprn) write (iout,*)"segment",i," longest fragment within",& + diffang_max*rad2deg,":",longest," fraction",ff + if (ff.lt.fract) fract = ff + endif + enddo + if (nn.gt.0) anorm = angn/nn + if (lprn) write (iout,*) "nn",nn," norm",anorm," fract:",fract + return + end subroutine angnorm2 +!------------------------------------------------------------------------- + real(kind=8) function angnorm1(nang_pair,iang_pair,lprn) + + use geometry_data, only:phi,theta,rad2deg +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.VAR' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.GEO' + logical :: lprn + integer :: nang_pair,iang_pair(2,nres) + real(kind=8) :: pinorm + integer :: j,ia1,ia2 + real(kind=8) :: angn,deltang + angn=0.0d0 + if (lprn) write (iout,'(80(1h*))') + if (lprn) write (iout,*) "nang_pair",nang_pair + if (lprn) write (iout,*) "angles" + do j=1,nang_pair + ia1 = iang_pair(1,j) + ia2 = iang_pair(2,j) +! deltang = pinorm(phi(ia1)-phi_ref(ia2)) + deltang=spherang(phi_ref(ia2),theta_ref(ia2-1),& + theta_ref(ia2),phi(ia2),theta(ia2-1),theta(ia2)) + if (lprn) write (iout,'(3i5,3f10.5)')j,ia1,ia2,rad2deg*phi(ia1),& + rad2deg*phi_ref(ia2),rad2deg*deltang + angn=angn+dabs(deltang) + enddo + if (lprn) & + write (iout,*)"nang_pair",nang_pair," angn",rad2deg*angn/nang_pair + angnorm1 = angn/nang_pair + return + end function angnorm1 +!------------------------------------------------------------------------------ + subroutine angnorm12(diff) + + use geometry_data, only:phi,theta,nstart_sup,nend_sup +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.VAR' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.GEO' + real(kind=8) :: pinorm,diff + integer :: nn4,nne,j + diff=0.0d0 + nn4 = nstart_sup+3 + nne = min0(nend_sup,nres) +! do j=nn4-1,nne +! diff = diff+rad2deg*dabs(pinorm(theta(j)-theta_ref(j))) +! enddo + do j=nn4,nne +! diff = diff+rad2deg*dabs(pinorm(phi(j)-phi_ref(j))) + diff=diff+spherang(phi_ref(j),theta_ref(j-1),& + theta_ref(j),phi(j),theta(j-1),theta(j)) + enddo + return + end subroutine angnorm12 +!-------------------------------------------------------------------------------- + real(kind=8) function spherang(gam1,theta11,theta12,& + gam2,theta21,theta22) +! implicit none + use geometry, only:arcos + real(kind=8) :: gam1,theta11,theta12,gam2,theta21,theta22,& + x1,x2,xmed,f1,f2,fmed + real(kind=8) :: tolx=1.0d-4, tolf=1.0d-4 + real(kind=8) :: sumcos +!el real(kind=8) :: pinorm,sumangp !arcos, + integer :: it,maxit=100 +! Calculate the difference of the angles of two superposed 4-redidue fragments +! +! O P +! \ / +! O'--C--C +! \ +! P' +! +! The fragment O'-C-C-P' is rotated by angle fi about the C-C axis +! to achieve the minimum difference between the O'-C-O and P-C-P angles; +! the sum of these angles is the difference returned by the function. +! +! 4/28/04 AL +! If thetas match, take the difference of gamma and exit. + if (dabs(theta11-theta12).lt.tolx & + .and. dabs(theta21-theta22).lt.tolx) then + spherang=dabs(pinorm(gam2-gam1)) + return + endif +! If the gammas are the same, take the difference of thetas and exit. + x1=0.0d0 + x2=0.5d0*pinorm(gam2-gam1) + if (dabs(x2) .lt. tolx) then + spherang=dabs(theta11-theta21)+dabs(theta12-theta22) + return + else if (x2.lt.0.0d0) then + x1=x2 + x2=0.0d0 + endif +! Else apply regula falsi method to compute optimum overlap of the terminal Calphas + f1=sumangp(gam1,theta11,theta12,gam2,theta21,theta22,x1) + f2=sumangp(gam1,theta11,theta12,gam2,theta21,theta22,x2) + do it=1,maxit + xmed=x1-f1*(x2-x1)/(f2-f1) + fmed=sumangp(gam1,theta11,theta12,gam2,theta21,theta22,xmed) +! write (*,*) 'it',it,' xmed ',xmed,' fmed ',fmed + if ( (dabs(xmed-x1).lt.tolx .or. dabs(x2-xmed).lt.tolx) & + .and. dabs(fmed).lt.tolf ) then + x1=xmed + f1=fmed + goto 10 + else if ( fmed*f1.lt.0.0d0 ) then + x2=xmed + f2=fmed + else + x1=xmed + f1=fmed + endif + enddo + 10 continue + spherang=arcos(dcos(theta11)*dcos(theta12) & + +dsin(theta11)*dsin(theta12)*dcos(x1))+ & + arcos(dcos(theta21)*dcos(theta22)+ & + dsin(theta21)*dsin(theta22)*dcos(gam2-gam1+x1)) + return + end function spherang +!-------------------------------------------------------------------------------- + real(kind=8) function sumangp(gam1,theta11,theta12,gam2,& + theta21,theta22,fi) +! implicit none + real(kind=8) :: gam1,theta11,theta12,gam2,theta21,theta22,fi,& + cost11,cost12,cost21,cost22,sint11,sint12,sint21,sint22,cosd1,& + cosd2 +! derivarive of the sum of the difference of the angles of a 4-residue fragment. +! real(kind=8) :: arcos + cost11=dcos(theta11) + cost12=dcos(theta12) + cost21=dcos(theta21) + cost22=dcos(theta22) + sint11=dsin(theta11) + sint12=dsin(theta12) + sint21=dsin(theta21) + sint22=dsin(theta22) + cosd1=cost11*cost12+sint11*sint12*dcos(fi) + cosd2=cost21*cost22+sint21*sint22*dcos(gam2-gam1+fi) + sumangp=sint11*sint12*dsin(fi)/dsqrt(1.0d0-cosd1*cosd1) & + +sint21*sint22*dsin(gam2-gam1+fi)/dsqrt(1.0d0-cosd2*cosd2) + return + end function sumangp +!----------------------------------------------------------------------------- +! contact.f +!----------------------------------------------------------------------------- + subroutine contact(lprint,ncont,icont,ist,ien) + + use calc_data + use geometry_data, only:c,dc,dc_norm + use energy_data, only:itype,maxcont +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'COMMON.CONTROL' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' +! include 'COMMON.CALC' +! include 'COMMON.CONTPAR' +! include 'COMMON.LOCAL' + integer :: ist,ien,kkk,iti,itj,itypi,itypj,i1,i2,it1,it2 + real(kind=8) :: csc !el,dist + real(kind=8),dimension(maxcont) :: cscore,omt1,omt2,omt12,& + ddsc,ddla,ddlb + integer :: ncont + integer,dimension(2,maxcont) :: icont + real(kind=8) :: u,v,a(3),b(3),dla,dlb + logical :: lprint +!el------- + dla=0.0d0 + dlb=0.0d0 +!el------ + ncont=0 + kkk=3 + if (lprint) then + do i=1,nres + write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i),& + c(3,i),dc(1,nres+i),dc(2,nres+i),dc(3,nres+i),& + dc_norm(1,nres+i),dc_norm(2,nres+i),dc_norm(3,nres+i) + enddo + endif + 110 format (a,'(',i3,')',9f8.3) + do i=ist,ien-kkk + iti=iabs(itype(i)) + if (iti.le.0 .or. iti.gt.ntyp) cycle + do j=i+kkk,ien + itj=iabs(itype(j)) + if (itj.le.0 .or. itj.gt.ntyp) cycle + itypi=iti + itypj=itj + 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) + dxi = dc_norm(1,nres+i) + dyi = dc_norm(2,nres+i) + dzi = dc_norm(3,nres+i) + dxj = dc_norm(1,nres+j) + dyj = dc_norm(2,nres+j) + dzj = dc_norm(3,nres+j) + do k=1,3 + a(k)=dc(k,nres+i) + b(k)=dc(k,nres+j) + enddo +! write (iout,*) (a(k),k=1,3),(b(k),k=1,3) + if (icomparfunc.eq.1) then + call contfunc(csc,iti,itj) + else if (icomparfunc.eq.2) then + call scdist(csc,iti,itj) + else if (icomparfunc.eq.3 .or. icomparfunc.eq.5) then + csc = dist(nres+i,nres+j) + else if (icomparfunc.eq.4) then + call odlodc(c(1,i),c(1,j),a,b,u,v,dla,dlb,csc) + else + write (*,*) "Error - Unknown sidechain contact function" + write (iout,*) "Error - Unknown sidechain contact function" + endif + if (csc.lt.sc_cutoff(iti,itj)) then +! write(iout,*) "i",i," j",j," dla",dla,dsc(iti), +! & " dlb",dlb,dsc(itj)," csc",csc,sc_cutoff(iti,itj), +! & dxi,dyi,dzi,dxi**2+dyi**2+dzi**2, +! & dxj,dyj,dzj,dxj**2+dyj**2+dzj**2,om1,om2,om12, +! & xj,yj,zj +! write(iout,*)'egb',itypi,itypj,chi1,chi2,chip1,chip2, +! & sig0ij,rij,rrij,om1,om2,om12,chiom1,chiom2,chiom12, +! & chipom1,chipom2,chipom12,sig,eps2rt,rij_shift,e2,evdw, +! & csc + ncont=ncont+1 + cscore(ncont)=csc + icont(1,ncont)=i + icont(2,ncont)=j + omt1(ncont)=om1 + omt2(ncont)=om2 + omt12(ncont)=om12 + ddsc(ncont)=1.0d0/rij + ddla(ncont)=dla + ddlb(ncont)=dlb + 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,5f8.3,3f10.5)') & + i,restyp(it1),i1,restyp(it2),i2,cscore(i),& + sc_cutoff(iabs(it1),iabs(it2)),ddsc(i),ddla(i),ddlb(i),& + omt1(i),omt2(i),omt12(i) + enddo + endif + return + end subroutine contact +#else +!---------------------------------------------------------------------------- + subroutine contact(lprint,ncont,icont) + + use energy_data, only: nnt,nct,itype,ipot,maxcont,sigma,sigmaii +! include 'DIMENSIONS' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' + real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6) + integer :: ncont,icont(2,maxcont) + logical :: lprint + integer :: kkk,i,j,i1,i2,it1,it2,iti,itj + real(kind=8) :: rcomp + ncont=0 + kkk=3 +! print *,'nnt=',nnt,' nct=',nct + do i=nnt+kkk,nct + iti=iabs(itype(i)) + do j=nnt,i-kkk + itj=iabs(itype(j)) + if (ipot.ne.4) then +! rcomp=sigmaii(iti,itj)+1.0D0 + rcomp=facont*sigmaii(iti,itj) + else +! rcomp=sigma(iti,itj)+1.0D0 + rcomp=facont*sigma(iti,itj) + endif +! rcomp=6.5D0 +! 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 + return + end subroutine contact +#endif +!---------------------------------------------------------------------------- + real(kind=8) function contact_fract(ncont,ncont_ref,& + icont,icont_ref) + + use energy_data, only:maxcont +! implicit none +! include 'DIMENSIONS' +! include 'COMMON.IOUNITS' + integer :: i,j,nmatch + integer :: ncont,ncont_ref + integer,dimension(2,maxcont) :: icont,icont_ref + nmatch=0 +! print *,'ncont=',ncont,' ncont_ref=',ncont_ref +! write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) +! write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) +! write (iout,'(20i4)') (icont(1,i),i=1,ncont) +! 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 +! print *,' nmatch=',nmatch +! contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) + contact_fract=dfloat(nmatch)/dfloat(ncont_ref) + return + end function contact_fract +#ifndef CLUSTER +!------------------------------------------------------------------------------ + subroutine pept_cont(lprint,ncont,icont) + + use geometry_data, only:c + use energy_data, only:maxcont,nnt,nct,itype +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' + integer :: ncont,icont(2,maxcont) + integer :: i,j,k,kkk,i1,i2,it1,it2 + logical :: lprint +!el real(kind=8) :: dist + real(kind=8) :: rcomp=5.5d0 + ncont=0 + kkk=0 + print *,'Entering pept_cont: 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 + return + end subroutine pept_cont +!----------------------------------------------------------------------------- +! cont_frag.f +!----------------------------------------------------------------------------- + subroutine contacts_between_fragments(lprint,is,ncont,icont,& + ncont_interfrag,icont_interfrag) + + use energy_data, only:itype,maxcont +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.INTERACT' +! include 'COMMON.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.NAMES' + integer :: icont(2,maxcont),ncont_interfrag(mmaxfrag),& + icont_interfrag(2,maxcont,mmaxfrag) + logical :: OK1,OK2,lprint + integer :: is,ncont,i,j,ind,nc,k,ic1,ic2,l,i1,i2,it1,it2 +! Determine the contacts that occur within a fragment and between fragments. + do i=1,nfrag(1) + do j=1,i + ind = icant(i,j) + nc=0 +! write (iout,*) "i",i,(ifrag(1,k,i),ifrag(2,k,i) +! & ,k=1,npiece(i,1)) +! write (iout,*) "j",j,(ifrag(1,k,j),ifrag(2,k,j) +! & ,k=1,npiece(j,1)) +! write (iout,*) "ncont",ncont + do k=1,ncont + ic1=icont(1,k) + ic2=icont(2,k) + OK1=.false. + l=0 + do while (.not.OK1 .and. l.lt.npiece(j,1)) + l=l+1 + OK1=ic1.ge.ifrag(1,l,j)-is .and. & + ic1.le.ifrag(2,l,j)+is + enddo + OK2=.false. + l=0 + do while (.not.OK2 .and. l.lt.npiece(i,1)) + l=l+1 + OK2=ic2.ge.ifrag(1,l,i)-is .and. & + ic2.le.ifrag(2,l,i)+is + enddo +! write(iout,*) "k",k," ic1",ic1," ic2",ic2," OK1",OK1, +! & " OK2",OK2 + if (OK1.and.OK2) then + nc=nc+1 + icont_interfrag(1,nc,ind)=ic1 + icont_interfrag(2,nc,ind)=ic2 +! write (iout,*) "nc",nc," ic1",ic1," ic2",ic2 + endif + enddo + ncont_interfrag(ind)=nc +! do k=1,ncont_interfrag(ind) +! i1=icont_interfrag(1,k,ind) +! i2=icont_interfrag(2,k,ind) +! it1=itype(i1) +! it2=itype(i2) +! write (iout,'(i3,2x,a,i4,2x,a,i4)') +! & i,restyp(it1),i1,restyp(it2),i2 +! enddo + enddo + enddo + if (lprint) then + write (iout,*) "Contacts within fragments:" + do i=1,nfrag(1) + write (iout,*) "Fragment",i," (",(ifrag(1,k,i),& + ifrag(2,k,i),k=1,npiece(i,1)),")" + ind=icant(i,i) + do k=1,ncont_interfrag(ind) + i1=icont_interfrag(1,k,ind) + i2=icont_interfrag(2,k,ind) + it1=itype(i1) + it2=itype(i2) + write (iout,'(i3,2x,a,i4,2x,a,i4)') & + i,restyp(it1),i1,restyp(it2),i2 + enddo + enddo + write (iout,*) + write (iout,*) "Contacts between fragments:" + do i=1,nfrag(1) + do j=1,i-1 + ind = icant(i,j) + write (iout,*) "Fragments",i," (",(ifrag(1,k,i),& + ifrag(2,k,i),k=1,npiece(i,1)),") and",j," (",& + (ifrag(1,k,j),ifrag(2,k,j),k=1,npiece(j,1)),")" + write (iout,*) "Number of contacts",& + ncont_interfrag(ind) + ind=icant(i,j) + do k=1,ncont_interfrag(ind) + i1=icont_interfrag(1,k,ind) + i2=icont_interfrag(2,k,ind) + it1=itype(i1) + it2=itype(i2) + write (iout,'(i3,2x,a,i4,2x,a,i4)') & + i,restyp(it1),i1,restyp(it2),i2 + enddo + enddo + enddo + endif + return + end subroutine contacts_between_fragments +!----------------------------------------------------------------------------- +! contfunc.f +!----------------------------------------------------------------------------- + subroutine contfunc(cscore,itypi,itypj) +! +! This subroutine calculates the contact function based on +! the Gay-Berne potential of interaction. +! + use calc_data +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'COMMON.CONTPAR' +! include 'COMMON.CALC' + integer :: expon=6 + integer :: itypi,itypj + real(kind=8) :: cscore,sig0ij,rrij,sig,rij_shift,evdw,e2 +! + sig0ij=sig_comp(itypi,itypj) + chi1=chi_comp(itypi,itypj) + chi2=chi_comp(itypj,itypi) + chi12=chi1*chi2 + chip1=chip_comp(itypi,itypj) + chip2=chip_comp(itypj,itypi) + chip12=chip1*chip2 + rrij=1.0D0/(xj*xj+yj*yj+zj*zj) + rij=dsqrt(rrij) +! Calculate angle-dependent terms of the contact function + 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 +! print *,'egb',itypi,itypj,chi1,chi2,chip1,chip2, +! & sig0ij, +! & rij,rrij,om1,om2,om12 +! Calculate eps1(om12) + faceps1=1.0D0-om12*chiom12 + faceps1_inv=1.0D0/faceps1 + eps1=dsqrt(faceps1_inv) +! Following variable is eps1*deps1/dom12 + eps1_om12=faceps1_inv*chiom12 +! Calculate sigma(om1,om2,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 +! 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 +! Following variable is the square root of eps2 + eps2rt=1.0D0-facp1*facp_inv + sigsq=1.0D0/sigsq + sig=sig0ij*dsqrt(sigsq) + rij_shift=1.0D0/rij-sig+sig0ij + if (rij_shift.le.0.0D0) then + evdw=1.0D1 + cscore = -dlog(evdw+1.0d-6) + return + endif + rij_shift=1.0D0/rij_shift + e2=(rij_shift*sig0ij)**expon + evdw=dabs(eps1*eps2rt**2*e2) + if (evdw.gt.1.0d1) evdw = 1.0d1 + cscore = -dlog(evdw+1.0d-6) + return + end subroutine contfunc +!------------------------------------------------------------------------------ + subroutine scdist(cscore,itypi,itypj) +! +! This subroutine calculates the contact distance +! + use calc_data +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'COMMON.CONTPAR' +! include 'COMMON.CALC' + integer :: itypi,itypj + real(kind=8) :: cscore,rrij + + chi1=chi_comp(itypi,itypj) + chi2=chi_comp(itypj,itypi) + chi12=chi1*chi2 + rrij=xj*xj+yj*yj+zj*zj + rij=dsqrt(rrij) +! Calculate angle-dependent terms of the contact function + 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 + om1om2=om1*om2 + chiom1=chi1*om1 + chiom2=chi2*om2 + cscore=dsqrt(rrij+chi1**2+chi2**2+2*rij*(chiom2-chiom1)-2*chiom12) + return + end subroutine scdist +!------------------------------------------------------------------------------ +! elecont.f +!------------------------------------------------------------------------------ + subroutine elecont(lprint,ncont,icont,ist,ien) + + use geometry_data, only:c + use energy_data, only:maxcont,rpp,epp,itype,itel,vblinv,vblinv2 +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' +! include 'COMMON.LOCAL' + logical :: lprint + integer :: i,j,k,ist,ien,iteli,itelj,ind,i1,i2,it1,it2,ic1,ic2 + real(kind=8) :: 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 + real(kind=8),dimension(2,2) :: elpp6c=reshape((/-0.2379d0,& + -0.2056d0,-0.2056d0,-0.0610d0/),shape(elpp6c)) + real(kind=8),dimension(2,2) :: elpp3c=reshape((/ 0.0503d0,& + 0.0000d0, 0.0000d0, 0.0692d0/),shape(elpp3c)) + real(kind=8),dimension(2,2) :: ael6c,ael3c,appc,bppc + real(kind=8) :: elcutoff=-0.3d0 + real(kind=8) :: elecutoff_14=-0.5d0 + integer :: ncont,icont(2,maxcont) + real(kind=8) :: 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. +! +! data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ +! data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ +!el data (elpp6c) /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ +!el data (elpp3c) / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ +!el data (elcutoff) /-0.3d0/ +!el data (elecutoff_14) /-0.5d0/ + ees=0.0d0 + evdw=0.0d0 + if (lprint) write (iout,'(a)') & + "Constants of electrostatic interaction energy expression." + do i=1,2 + do j=1,2 + rri=rpp(i,j)**6 + appc(i,j)=epp(i,j)*rri*rri + bppc(i,j)=-2.0*epp(i,j)*rri + ael6c(i,j)=elpp6c(i,j)*4.2**6 + ael3c(i,j)=elpp3c(i,j)*4.2**3 + if (lprint) & + write (iout,'(2i2,4e15.4)') i,j,appc(i,j),bppc(i,j),ael6c(i,j),& + ael3c(i,j) + enddo + enddo + ncont=0 + do 1 i=ist,ien-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,ien-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 & + .or.iteli.eq.0 .or.itelj.eq.0) goto 4 + aaa=appc(iteli,itelj) + bbb=bppc(iteli,itelj) + ael6i=ael6c(iteli,itelj) + ael3i=ael3c(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=ael6i*r6ij + fac4=ael3i*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 +! 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 +! write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2, +! & " 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 +! 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 +! write (iout,*) "ncont",ncont +! do k=1,ncont +! write (iout,*) icont(1,k),icont(2,k) +! 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 +! 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 +! write (iout,*) "ncont",ncont +! do k=1,ncont +! write (iout,*) icont(1,k),icont(2,k) +! 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 subroutine elecont +!------------------------------------------------------------------------------ +! match_contact.f +!------------------------------------------------------------------------------ + subroutine match_contact(ishif1,ishif2,nc_match,nc_match1_max,& + ncont_ref,icont_ref,ncont,icont,jfrag,n_shif1,n_shif2,& + nc_frac,nc_req_set,istr,llocal,lprn) + + use energy_data, only:maxcont +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'COMMON.IOUNITS' + integer :: ncont_ref,ncont,ishift,ishif2,nc_match + integer,dimension(2,maxcont) :: icont_ref,icont !(2,maxcont) + real(kind=8) :: nc_frac + logical :: llocal,lprn + integer :: ishif1,nc_match1_max,jfrag,n_shif1,n_shif2,& + nc_req_set,istr,nc_match_max + integer :: i,nc_req,nc_match1,is,js + nc_match_max=0 + do i=1,ncont_ref + nc_match_max=nc_match_max+ & + min0(icont_ref(2,i)-icont_ref(1,i)-1,3) + enddo + if (istr.eq.3) then + nc_req=0 + else if (nc_req_set.eq.0) then + nc_req=nc_match_max*nc_frac + else + nc_req = dmin1(nc_match_max*nc_frac+0.5d0,& + dfloat(nc_req_set)+1.0d-7) + endif +! write (iout,*) "match_contact: nc_req:",nc_req +! write (iout,*) "nc_match_max",nc_match_max +! write (iout,*) "jfrag",jfrag," n_shif1",n_shif1, +! & " n_shif2",n_shif2 +! Match current contact map against reference contact map; exit, if at least +! half of the contacts match + call ncont_match(nc_match,nc_match1,0,0,ncont_ref,icont_ref,& + ncont,icont,jfrag,llocal,lprn) + nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",0,0," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_req.gt.0 .and. nc_match.ge.nc_req .or. & + nc_req.eq.0 .and. nc_match.eq.1) then + ishif1=0 + ishif2=0 + return + endif +! If sufficient matches are not found, try to shift contact maps up to three +! positions. + if (n_shif1.gt.0) then + do is=1,n_shif1 +! The following four tries help to find shifted beta-sheet patterns +! Shift "left" strand backward + call ncont_match(nc_match,nc_match1,-is,0,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",-is,0," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_req.gt.0 .and. nc_match.ge.nc_req .or. & + nc_req.eq.0 .and. nc_match.eq.1) then + ishif1=-is + ishif2=0 + return + endif +! Shift "left" strand forward + call ncont_match(nc_match,nc_match1,is,0,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",is,0," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_req.gt.0 .and. nc_match.ge.nc_req .or. & + nc_req.eq.0 .and. nc_match.eq.1) then + ishif1=is + ishif2=0 + return + endif + enddo + if (nc_req.eq.0) return +! Shift "right" strand backward + do is=1,n_shif1 + call ncont_match(nc_match,nc_match1,0,-is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",0,-is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=0 + ishif2=-is + return + endif +! Shift "right" strand upward + call ncont_match(nc_match,nc_match1,0,is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",0,is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=0 + ishif2=is + return + endif + enddo ! is +! Now try to shift both residues in contacts. + do is=1,n_shif1 + do js=1,is + if (js.ne.is) then + call ncont_match(nc_match,nc_match1,-is,-js,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",-is,-js," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=-is + ishif2=-js + return + endif + call ncont_match(nc_match,nc_match1,is,js,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",is,js," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=is + ishif2=js + return + endif +! + call ncont_match(nc_match,nc_match1,-js,-is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",-js,-is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=-js + ishif2=-is + return + endif +! + call ncont_match(nc_match,nc_match1,js,is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",js,is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=js + ishif2=is + return + endif + endif +! + if (is+js.le.n_shif1) then + call ncont_match(nc_match,nc_match1,-is,js,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",-is,js," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=-is + ishif2=js + return + endif +! + call ncont_match(nc_match,nc_match1,js,-is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",js,-is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=js + ishif2=-is + return + endif + endif +! + enddo !js + enddo !is + endif + + if (n_shif2.gt.0) then + do is=1,n_shif2 + call ncont_match(nc_match,nc_match1,-is,-is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",-is,-is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=-is + ishif2=-is + return + endif + call ncont_match(nc_match,nc_match1,is,is,ncont_ref,& + icont_ref,ncont,icont,jfrag,llocal,lprn) + if (nc_match1.gt.nc_match1_max) nc_match1_max=nc_match1 + if (lprn .and. nc_match.gt.0) write (iout,*) & + "Shift:",is,is," nc_match1",nc_match1,& + " nc_match=",nc_match," req'd",nc_req + if (nc_match.ge.nc_req) then + ishif1=is + ishif2=is + return + endif + enddo + endif +! If this point is reached, the contact maps are different. + nc_match=0 + ishif1=0 + ishif2=0 + return + end subroutine match_contact +!------------------------------------------------------------------------- + subroutine ncont_match(nc_match,nc_match1,ishif1,ishif2,& + ncont_ref,icont_ref,ncont,icont,jfrag,llocal,lprn) + + use energy_data, only:nnt,nct,maxcont +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.INTERACT' +! include 'COMMON.GEO' +! include 'COMMON.COMPAR' + logical :: llocal,lprn + integer ncont_ref,ncont,ishift,ishif2,nang_pair + integer,dimension(2,maxcont) :: icont_ref,icont,icont_match !(2,maxcont) + integer,dimension(2,nres) :: iang_pair !(2,maxres) + integer :: nc_match,nc_match1,ishif1,jfrag + integer :: i,j,ic1,ic2 + real(kind=8) :: diffang,fract,rad2deg + +! Compare the contact map against the reference contact map; they're stored +! in ICONT and ICONT_REF, respectively. The current contact map can be shifted. + if (lprn) write (iout,'(80(1h*))') + nc_match=0 + nc_match1=0 +! Check the local structure by comparing dihedral angles. +! write (iout,*) "ncont_match: ncont_ref",ncont_ref," llocal",llocal + if (llocal .and. ncont_ref.eq.0) then +! If there are no contacts just compare the dihedral angles and exit. + call angnorm(jfrag,ishif1,ishif2,ang_cut1(jfrag),diffang,fract,& + lprn) + if (lprn) write (iout,*) "diffang:",diffang*rad2deg,& + " ang_cut:",ang_cut(jfrag)*rad2deg," fract",fract + if (diffang.le.ang_cut(jfrag) .and. fract.ge.frac_min(jfrag)) & + then + nc_match=1 + else + nc_match=0 + endif + return + endif + nang_pair=0 + do i=1,ncont + ic1=icont(1,i)+ishif1 + ic2=icont(2,i)+ishif2 +! write (iout,*) "i",i," ic1",ic1," ic2",ic2 + if (ic1.lt.nnt .or. ic2.gt.nct) goto 10 + do j=1,ncont_ref + if (ic1.eq.icont_ref(1,j).and.ic2.eq.icont_ref(2,j)) then + nc_match=nc_match+min0(icont_ref(2,j)-icont_ref(1,j)-1,3) + nc_match1=nc_match1+1 + icont_match(1,nc_match1)=ic1 + icont_match(2,nc_match1)=ic2 +! call add_angpair(icont(1,i),icont_ref(1,j), +! & nang_pair,iang_pair) +! call add_angpair(icont(2,i),icont_ref(2,j), +! & nang_pair,iang_pair) + if (lprn) write (iout,*) "Contacts:",icont(1,i),icont(2,i),& + " match",icont_ref(1,j),icont_ref(2,j),& + " shifts",ishif1,ishif2 + goto 10 + endif + enddo + 10 continue + enddo + if (lprn) then + write (iout,*) "nc_match",nc_match," nc_match1",nc_match1 + write (iout,*) "icont_match" + do i=1,nc_match1 + write (iout,*) icont_match(1,i),icont_match(2,i) + enddo + endif + if (llocal .and. nc_match.gt.0) then + call angnorm2(jfrag,ishif1,ishif2,nc_match1,icont_match,lprn,& + ang_cut1(jfrag),diffang,fract) + if (lprn) write (iout,*) "diffang:",diffang*rad2deg,& + " ang_cut:",ang_cut(jfrag)*rad2deg,& + " ang_cut1",ang_cut1(jfrag)*rad2deg + if (diffang.gt.ang_cut(jfrag) & + .or. fract.lt.frac_min(jfrag)) nc_match=0 + endif +! if (nc_match.gt.0) then +! diffang = angnorm1(nang_pair,iang_pair,lprn) +! if (diffang.gt.ang_cut(jfrag)) nc_match=0 +! endif + if (lprn) write (iout,*) "ishif1",ishif1," ishif2",ishif2,& + " diffang",rad2deg*diffang," nc_match",nc_match + return + end subroutine ncont_match +!------------------------------------------------------------------------------ + subroutine match_secondary(jfrag,isecstr,nsec_match,lprn) +! This subroutine compares the secondary structure (isecstr) of fragment jfrag +! conformation considered to that of the reference conformation. +! Returns the number of equivalent residues (nsec_match). +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.PEPTCONT' +! include 'COMMON.COMPAR' + logical :: lprn + integer :: isecstr(nres) + integer :: jfrag,nsec_match,npart,i,j + npart = npiece(jfrag,1) + nsec_match=0 + if (lprn) then + write (iout,*) "match_secondary jfrag",jfrag," ifrag",& + (ifrag(1,i,jfrag),ifrag(2,i,jfrag),i=1,npart) + write (iout,'(80i1)') (isec_ref(j),j=1,nres) + write (iout,'(80i1)') (isecstr(j),j=1,nres) + endif + do i=1,npart + do j=ifrag(1,i,jfrag),ifrag(2,i,jfrag) +! The residue has equivalent conformational state to that of the reference +! structure, if: +! a) the conformational states are equal or +! b) the reference state is a coil and that of the conformation considered +! is a strand or +! c) the conformational state of the conformation considered is a strand +! and that of the reference conformation is a coil. +! 10/28/02 - case (b) deleted. + if (isecstr(j).eq.isec_ref(j) .or. & +! & isecstr(j).eq.0 .and. isec_ref(j).eq.1 .or. + isec_ref(j).eq.0 .and. isecstr(j).eq.1) & + nsec_match=nsec_match+1 + enddo + enddo + return + end subroutine match_secondary +!------------------------------------------------------------------------------ +! odlodc.f +!------------------------------------------------------------------------------ + subroutine odlodc(r1,r2,a,b,uu,vv,aa,bb,dd) + + use energy_data, only:ncont_ref,icont_ref!,nsccont_frag_ref,& +! isccont_frag_ref +! implicit real*8 (a-h,o-z) + real(kind=8),dimension(3) :: r1,r2,a,b,x,y + real(kind=8) :: uu,vv,aa,bb,dd + real(kind=8) :: ab,ar,br,det,dd1,dd2,dd3,dd4,dd5 +!el odl(u,v) = (r1(1)-r2(1))**2+(r1(2)-r2(2))**2+(r1(3)-r2(3))**2 & +!el + 2*ar*u - 2*br*v - 2*ab*u*v + aa*u**2 + bb*v**2 +! print *,"r1",(r1(i),i=1,3) +! print *,"r2",(r2(i),i=1,3) +! print *,"a",(a(i),i=1,3) +! print *,"b",(b(i),i=1,3) + aa = a(1)**2+a(2)**2+a(3)**2 + bb = b(1)**2+b(2)**2+b(3)**2 + ab = a(1)*b(1)+a(2)*b(2)+a(3)*b(3) + ar = a(1)*(r1(1)-r2(1))+a(2)*(r1(2)-r2(2))+a(3)*(r1(3)-r2(3)) + br = b(1)*(r1(1)-r2(1))+b(2)*(r1(2)-r2(2))+b(3)*(r1(3)-r2(3)) + det = aa*bb-ab**2 +! print *,'aa',aa,' bb',bb,' ab',ab,' ar',ar,' br',br,' det',det + uu = (-ar*bb+br*ab)/det + vv = (br*aa-ar*ab)/det +! print *,u,v + uu=dmin1(uu,1.0d0) + uu=dmax1(uu,0.0d0) + vv=dmin1(vv,1.0d0) + vv=dmax1(vv,0.0d0) +!el dd1 = odl(uu,vv) + dd1 = odl(uu,vv,r1,r2,ar,br,ab,aa,bb) +!el dd2 = odl(0.0d0,0.0d0) + dd2 = odl(0.0d0,0.0d0,r1,r2,ar,br,ab,aa,bb) +!el dd3 = odl(0.0d0,1.0d0) + dd3 = odl(0.0d0,1.0d0,r1,r2,ar,br,ab,aa,bb) +!el dd4 = odl(1.0d0,0.0d0) + dd4 = odl(1.0d0,0.0d0,r1,r2,ar,br,ab,aa,bb) +!el dd5 = odl(1.0d0,1.0d0) + dd5 = odl(1.0d0,1.0d0,r1,r2,ar,br,ab,aa,bb) + dd = dsqrt(dmin1(dd1,dd2,dd3,dd4,dd5)) + if (dd.eq.dd2) then + uu=0.0d0 + vv=0.0d0 + else if (dd.eq.dd3) then + uu=0.0d0 + vv=1.0d0 + else if (dd.eq.dd4) then + uu=1.0d0 + vv=0.0d0 + else if (dd.eq.dd5) then + uu=1.0d0 + vv=1.0d0 + endif +! Control check +! do i=1,3 +! x(i)=r1(i)+u*a(i) +! y(i)=r2(i)+v*b(i) +! enddo +! dd1 = (x(1)-y(1))**2+(x(2)-y(2))**2+(x(3)-y(3))**2 +! dd1 = dsqrt(dd1) + aa = dsqrt(aa) + bb = dsqrt(bb) +! write (8,*) uu,vv,dd,dd1 +! print *,dd,dd1 + return + end subroutine odlodc +!------------------------------------------------------------------------------ + real(kind=8) function odl(u,v,r1,r2,ar,br,ab,aa,bb) + + real(kind=8),dimension(3) :: r1,r2 + real(kind=8) :: aa,bb,u,v,ar,br,ab + + odl = (r1(1)-r2(1))**2+(r1(2)-r2(2))**2+(r1(3)-r2(3))**2 & + + 2*ar*u - 2*br*v - 2*ab*u*v + aa*u**2 + bb*v**2 + + end function odl +!------------------------------------------------------------------------------ +! proc_cont.f +!------------------------------------------------------------------------------ + subroutine proc_cont + + use geometry_data, only:rad2deg + use energy_data, only:ncont_ref,icont_ref!,nsccont_frag_ref,& +! isccont_frag_ref +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.TIME1' +! include 'COMMON.SBRIDGE' +! include 'COMMON.CONTROL' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.HEADER' +! include 'COMMON.CONTACTS1' +! include 'COMMON.PEPTCONT' +! include 'COMMON.GEO' + integer :: i,j,k,ind,len_cut,ndigit,length_frag + + write (iout,*) "proc_cont: nlevel",nlevel + if (nlevel.lt.0) then + write (iout,*) "call define_fragments" + call define_fragments + else + write (iout,*) "call secondary2" + call secondary2(.true.,.false.,ncont_pept_ref,icont_pept_ref,& + isec_ref) + endif + write (iout,'(80(1h=))') + write (iout,*) "Electrostatic contacts" + call contacts_between_fragments(.true.,0,ncont_pept_ref,& + icont_pept_ref,ncont_frag_ref(1),icont_frag_ref(1,1,1)) + write (iout,'(80(1h=))') + write (iout,*) "Side chain contacts" + call contacts_between_fragments(.true.,0,ncont_ref,& + icont_ref,nsccont_frag_ref(1),isccont_frag_ref(1,1,1)) + if (nlevel.lt.0) then + do i=1,nfrag(1) + ind=icant(i,i) + len_cut=1000 + if (istruct(i).le.1) then + len_cut=max0(len_frag(i,1)*4/5,3) + else if (istruct(i).eq.2 .or. istruct(i).eq.4) then + len_cut=max0(len_frag(i,1)*2/5,3) + endif + write (iout,*) "i",i," istruct",istruct(i)," ncont_frag",& + ncont_frag_ref(ind)," len_cut",len_cut,& + " icont_single",icont_single," iloc_single",iloc_single + iloc(i)=iloc_single + if (iloc(i).gt.0) write (iout,*) & + "Local structure used to compare structure of fragment",i,& + " to native." + if (istruct(i).ne.3 .and. istruct(i).ne.0 & + .and. icont_single.gt.0 .and. & + ncont_frag_ref(ind).ge.len_cut) then + write (iout,*) "Electrostatic contacts used to compare",& + " structure of fragment",i," to native." + ielecont(i,1)=1 + isccont(i,1)=0 + else if (icont_single.gt.0 .and. nsccont_frag_ref(ind) & + .ge.len_cut) then + write (iout,*) "Side chain contacts used to compare",& + " structure of fragment",i," to native." + isccont(i,1)=1 + ielecont(i,1)=0 + else + write (iout,*) "Contacts not used to compare",& + " structure of fragment",i," to native." + ielecont(i,1)=0 + isccont(i,1)=0 + nc_req_setf(i,1)=0 + endif + if (irms_single.gt.0 .or. isccont(i,1).eq.0 & + .and. ielecont(i,1).eq.0) then + write (iout,*) "RMSD used to compare",& + " structure of fragment",i," to native." + irms(i,1)=1 + else + write (iout,*) "RMSD not used to compare",& + " structure of fragment",i," to native." + irms(i,1)=0 + endif + enddo + endif + if (nlevel.lt.-1) then + call define_pairs + nlevel = -nlevel + if (nlevel.gt.3) nlevel=3 + if (nlevel.eq.3) then + nfrag(3)=1 + npiece(1,3)=nfrag(1) + do i=1,nfrag(1) + ipiece(i,1,3)=i + enddo + ielecont(1,3)=0 + isccont(1,3)=0 + irms(1,3)=1 + n_shift(1,1,3)=0 + n_shift(2,1,3)=0 + endif + else if (nlevel.eq.-1) then + nlevel=1 + endif + isnfrag(1)=0 + do i=1,nlevel + isnfrag(i+1)=isnfrag(i)+nfrag(i) + enddo + ndigit=3*nfrag(1) + do i=2,nlevel + ndigit=ndigit+2*nfrag(i) + enddo + write (iout,*) "ndigit",ndigit + if (.not.binary .and. ndigit.gt.30) then + write (iout,*) "Highest class too large; switching to",& + " binary representation." + binary=.true. + endif + write (iout,*) "isnfrag",(isnfrag(i),i=1,nlevel+1) + write(iout,*) "rmscut_base_up",rmscut_base_up,& + " rmscut_base_low",rmscut_base_low," rmsup_lim",rmsup_lim + do i=1,nlevel + do j=1,nfrag(i) + length_frag = 0 + if (i.eq.1) then + do k=1,npiece(j,i) + length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1 + enddo + else + do k=1,npiece(j,i) + length_frag=length_frag+len_frag(ipiece(k,j,i),1) + enddo + endif + len_frag(j,i)=length_frag + rmscutfrag(1,j,i)=rmscut_base_up*length_frag + rmscutfrag(2,j,i)=rmscut_base_low*length_frag + if (rmscutfrag(1,j,i).lt.rmsup_lim) & + rmscutfrag(1,j,i)=rmsup_lim + if (rmscutfrag(1,j,i).gt.rmsupup_lim) & + rmscutfrag(1,j,i)=rmsupup_lim + enddo + enddo + write (iout,*) "Level",1," number of fragments:",nfrag(1) + do j=1,nfrag(1) + write (iout,*) npiece(j,1),(ifrag(1,k,j),ifrag(2,k,j),& + k=1,npiece(j,1)),len_frag(j,1),rmscutfrag(1,j,1),& + rmscutfrag(2,j,1),n_shift(1,j,1),n_shift(2,j,1),& + ang_cut(j)*rad2deg,ang_cut1(j)*rad2deg,frac_min(j),& + nc_fragm(j,1),nc_req_setf(j,1),istruct(j) + enddo + do i=2,nlevel + write (iout,*) "Level",i," number of fragments:",nfrag(i) + do j=1,nfrag(i) + write (iout,*) npiece(j,i),(ipiece(k,j,i),& + k=1,npiece(j,i)),len_frag(j,i),rmscutfrag(1,j,i),& + rmscutfrag(2,j,i),n_shift(1,j,i),n_shift(2,j,i),& + nc_fragm(j,i),nc_req_setf(j,i) + enddo + enddo + return + end subroutine proc_cont +!------------------------------------------------------------------------------ +! define_pairs.f +!------------------------------------------------------------------------------ + subroutine define_pairs + +! use energy_data, only:nsccont_frag_ref +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.TIME1' +! include 'COMMON.SBRIDGE' +! include 'COMMON.CONTROL' +! include 'COMMON.COMPAR' +! include 'COMMON.FRAG' +! include 'COMMON.CHAIN' +! include 'COMMON.HEADER' +! include 'COMMON.GEO' +! include 'COMMON.CONTACTS1' +! include 'COMMON.PEPTCONT' + integer :: j,k,i,length_frag,ind,ll1,ll2,len_cut + + do j=1,nfrag(1) + length_frag = 0 + do k=1,npiece(j,1) + length_frag=length_frag+ifrag(2,k,j)-ifrag(1,k,j)+1 + enddo + len_frag(j,1)=length_frag + write (iout,*) "Fragment",j," length",len_frag(j,1) + enddo + nfrag(2)=0 + do i=1,nfrag(1) + do j=i+1,nfrag(1) + ind = icant(i,j) + if (istruct(i).le.1 .or. istruct(j).le.1) then + if (istruct(i).le.1) then + ll1=len_frag(i,1) + else + ll1=len_frag(i,1)/2 + endif + if (istruct(j).le.1) then + ll2=len_frag(j,1) + else + ll2=len_frag(j,1)/2 + endif + len_cut=max0(min0(ll1*2/3,ll2*4/5),3) + else + if (istruct(i).eq.2 .or. istruct(i).eq.4) then + ll1=len_frag(i,1)/2 + else + ll1=len_frag(i,1) + endif + if (istruct(j).eq.2 .or. istruct(j).eq.4) then + ll2=len_frag(j,1)/2 + else + ll2=len_frag(j,1) + endif + len_cut=max0(min0(ll1*4/5,ll2)*4/5,3) + endif + write (iout,*) "Fragments",i,j," structure",istruct(i),& + istruct(j)," # contacts",& + ncont_frag_ref(ind),nsccont_frag_ref(ind),& + " lengths",len_frag(i,1),len_frag(j,1),& + " ll1",ll1," ll2",ll2," len_cut",len_cut + if ((istruct(i).eq.1 .or. istruct(j).eq.1) .and. & + nsccont_frag_ref(ind).ge.len_cut ) then + if (istruct(i).eq.1 .and. istruct(j).eq.1) then + write (iout,*) "Adding pair of helices",i,j,& + " based on SC contacts" + else + write (iout,*) "Adding helix+strand/sheet pair",i,j,& + " based on SC contacts" + endif + nfrag(2)=nfrag(2)+1 + if (icont_pair.gt.0) then + write (iout,*) "# SC contacts will be used",& + " in comparison." + isccont(nfrag(2),2)=1 + endif + if (irms_pair.gt.0) then + write (iout,*) "Fragment RMSD will be used",& + " in comparison." + irms(nfrag(2),2)=1 + endif + npiece(nfrag(2),2)=2 + ipiece(1,nfrag(2),2)=i + ipiece(2,nfrag(2),2)=j + ielecont(nfrag(2),2)=0 + n_shift(1,nfrag(2),2)=nshift_pair + n_shift(2,nfrag(2),2)=nshift_pair + nc_fragm(nfrag(2),2)=ncfrac_pair + nc_req_setf(nfrag(2),2)=ncreq_pair + else if ((istruct(i).ge.2 .and. istruct(i).le.4) & + .and. (istruct(j).ge.2 .and. istruct(i).le.4) & + .and. ncont_frag_ref(ind).ge.len_cut ) then + nfrag(2)=nfrag(2)+1 + write (iout,*) "Adding pair strands/sheets",i,j,& + " based on pp contacts" + if (icont_pair.gt.0) then + write (iout,*) "# pp contacts will be used",& + " in comparison." + ielecont(nfrag(2),2)=1 + endif + if (irms_pair.gt.0) then + write (iout,*) "Fragment RMSD will be used",& + " in comparison." + irms(nfrag(2),2)=1 + endif + npiece(nfrag(2),2)=2 + ipiece(1,nfrag(2),2)=i + ipiece(2,nfrag(2),2)=j + ielecont(nfrag(2),2)=1 + isccont(nfrag(2),2)=0 + n_shift(1,nfrag(2),2)=nshift_pair + n_shift(2,nfrag(2),2)=nshift_pair + nc_fragm(nfrag(2),2)=ncfrac_bet + nc_req_setf(nfrag(2),2)=ncreq_bet + endif + enddo + enddo + write (iout,*) "Pairs found" + do i=1,nfrag(2) + write (iout,*) ipiece(1,i,2),ipiece(2,i,2) + enddo + return + end subroutine define_pairs +!------------------------------------------------------------------------------ +! icant.f +!------------------------------------------------------------------------------ + INTEGER FUNCTION ICANT(I,J) + integer :: i,j + IF (I.GE.J) THEN + ICANT=(I*(I-1))/2+J + ELSE + ICANT=(J*(J-1))/2+I + ENDIF + RETURN + END FUNCTION ICANT +!------------------------------------------------------------------------------ +! mysort.f +!------------------------------------------------------------------------------ + subroutine imysort(n, m, mm, x, y, z, z1, z2, z3, z4, z5, z6) +! implicit none + integer :: n,m,mm + integer :: x(m,mm,n),y(n),z(n),z1(2,n),z6(n),xmin,xtemp + real(kind=8) :: z2(n),z3(n),z4(n),z5(n) + real(kind=8) :: xxtemp + integer :: i,j,k,imax + do i=1,n + xmin=x(1,1,i) + imax=i + do j=i+1,n + if (x(1,1,j).lt.xmin) then + imax=j + xmin=x(1,1,j) + endif + enddo + xxtemp=z2(imax) + z2(imax)=z2(i) + z2(i)=xxtemp + xxtemp=z3(imax) + z3(imax)=z3(i) + z3(i)=xxtemp + xxtemp=z4(imax) + z4(imax)=z4(i) + z4(i)=xxtemp + xxtemp=z5(imax) + z5(imax)=z5(i) + z5(i)=xxtemp + xtemp=y(imax) + y(imax)=y(i) + y(i)=xtemp + xtemp=z(imax) + z(imax)=z(i) + z(i)=xtemp + xtemp=z6(imax) + z6(imax)=z6(i) + z6(i)=xtemp + do j=1,2 + xtemp=z1(j,imax) + z1(j,imax)=z1(j,i) + z1(j,i)=xtemp + enddo + do j=1,m + do k=1,mm + xtemp=x(j,k,imax) + x(j,k,imax)=x(j,k,i) + x(j,k,i)=xtemp + enddo + enddo + enddo + return + end subroutine imysort +!------------------------------------------------------------------------------ +! qwolynes.f +!------------------------------------------------------------------------------- + real(kind=8) function qwolynes(ilevel,jfrag) + + use geometry_data, only:cref,nperm + use control_data, only:symetr + use energy_data, only:nnt,nct,itype +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.CONTROL' + integer :: ilevel,jfrag,kkk + integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp + integer :: nsep=3 + real(kind=8),dimension(:),allocatable :: tempus !(maxperm) + real(kind=8) :: maxiQ !dist, + real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM + logical :: lprn=.false. + real(kind=8) :: x !el sigm +!el sigm(x)=0.25d0*x + nperm=1 + maxiQ=0 + do i=1,symetr + nperm=i*nperm + enddo +! write (iout,*) "QWolyes: " jfrag",jfrag, +! & " ilevel",ilevel + allocate(tempus(nperm)) + do kkk=1,nperm + qq = 0.0d0 + if (ilevel.eq.0) then + if (lprn) write (iout,*) "Q computed for whole molecule" + nl=0 + do il=nnt+nsep,nct + do jl=nnt,il-nsep + dij=0.0d0 + dijCM=0.0d0 + d0ij=0.0d0 + d0ijCM=0.0d0 + qqij=0.0d0 + qqijCM=0.0d0 + nl=nl+1 + d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & + (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & + (cref(3,jl,kkk)-cref(3,il,kkk))**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,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (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) + endif + qq = qq+qqij+qqijCM + if (lprn) then + write (iout,*) "il",il," jl",jl,& + " itype",itype(il),itype(jl) + write (iout,*)"d0ij",d0ij," dij",dij," d0ijCM",d0ijCM,& + " dijCM",dijCM," qqij",qqij," qqijCM",qqijCM + endif + enddo + enddo + qq = qq/nl + if (lprn) write (iout,*) "nl",nl," qq",qq + else if (ilevel.eq.1) then + if (lprn) write (iout,*) "Level",ilevel," fragment",jfrag + nl=0 +! write (iout,*) "nlist_frag",nlist_frag(jfrag) + do i=2,nlist_frag(jfrag) + do j=1,i-1 + il=list_frag(i,jfrag) + jl=list_frag(j,jfrag) + if (iabs(il-jl).gt.nsep) then + dij=0.0d0 + dijCM=0.0d0 + d0ij=0.0d0 + d0ijCM=0.0d0 + qqij=0.0d0 + qqijCM=0.0d0 + nl=nl+1 + d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & + (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & + (cref(3,jl,kkk)-cref(3,il,kkk))**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,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (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) + endif + qq = qq+qqij+qqijCM + if (lprn) then + write (iout,*) "i",i," j",j," il",il," jl",jl,& + " itype",itype(il),itype(jl) + write (iout,*)"d0ij",d0ij," dij",dij," d0ijCM",d0ijCM,& + " dijCM",dijCM," qqij",qqij," qqijCM",qqijCM + endif + endif + enddo + enddo + qq = qq/nl + if (lprn) write (iout,*) "nl",nl," qq",qq + else if (ilevel.eq.2) then + np=npiece(jfrag,ilevel) + nl=0 + do i=2,np + ip=ipiece(i,jfrag,ilevel) + do j=1,nlist_frag(ip) + il=list_frag(j,ip) + do k=1,i-1 + kp=ipiece(k,jfrag,ilevel) + do l=1,nlist_frag(kp) + kl=list_frag(l,kp) + if (iabs(kl-il).gt.nsep) then + nl=nl+1 + dij=0.0d0 + dijCM=0.0d0 + d0ij=0.0d0 + d0ijCM=0.0d0 + qqij=0.0d0 + qqijCM=0.0d0 + d0ij=dsqrt((cref(1,kl,kkk)-cref(1,il,kkk))**2+ & + (cref(2,kl,kkk)-cref(2,il,kkk))**2+ & + (cref(3,kl,kkk)-cref(3,il,kkk))**2) + dij=dist(il,kl) + qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) + if (itype(il).ne.10 .or. itype(kl).ne.10) then + nl=nl+1 + d0ijCM=dsqrt( & + (cref(1,kl+nres,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,kl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (cref(3,kl+nres,kkk)-cref(3,il+nres,kkk))**2) + dijCM=dist(il+nres,kl+nres) + qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/ & + (sigm(d0ijCM)))**2) + endif + qq = qq+qqij+qqijCM + if (lprn) then + write (iout,*) "i",i," j",j," k",k," l",l," il",il,& + " kl",kl," itype",itype(il),itype(kl) + write (iout,*) " d0ij",d0ij," dij",dij," d0ijCM",& + d0ijCM," dijCM",dijCM," qqij",qqij," qqijCM",qqijCM + endif + endif + enddo ! l + enddo ! k + enddo ! j + enddo ! i + qq = qq/nl + if (lprn) write (iout,*) "nl",nl," qq",qq + else + write (iout,*)"Error: Q can be computed only for level 1 and 2." + endif + tempus(kkk)=qq + enddo + do kkk=1,nperm + if (maxiQ.le.tempus(kkk)) maxiQ=tempus(kkk) + enddo + qwolynes=1.0d0-maxiQ + deallocate(tempus) + return + end function qwolynes +!------------------------------------------------------------------------------- + real(kind=8) function sigm(x) + real(kind=8) :: x + sigm=0.25d0*x + return + end function sigm +!------------------------------------------------------------------------------- + subroutine fragment_list +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.COMPAR' + logical :: lprn=.true. + integer :: i,ilevel,j,k,jfrag + do jfrag=1,nfrag(1) + nlist_frag(jfrag)=0 + do i=1,npiece(jfrag,1) + if (lprn) write (iout,*) "jfrag=",jfrag,& + "i=",i," fragment",ifrag(1,i,jfrag),& + ifrag(2,i,jfrag) + do j=ifrag(1,i,jfrag),ifrag(2,i,jfrag) + do k=1,nlist_frag(jfrag) + if (list_frag(k,jfrag).eq.j) goto 10 + enddo + nlist_frag(jfrag)=nlist_frag(jfrag)+1 + list_frag(nlist_frag(jfrag),jfrag)=j + enddo + 10 continue + enddo + enddo + write (iout,*) "Fragment list" + do j=1,nfrag(1) + write (iout,*)"Fragment",j," list",(list_frag(k,j),& + k=1,nlist_frag(j)) + enddo + return + end subroutine fragment_list +!------------------------------------------------------------------------------- + real(kind=8) function rmscalc(ishif,i,j,jcon,lprn) + + use w_comm_local + use control_data, only:symetr + use geometry_data, only:nperm +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.CONTROL' + real(kind=8) :: przes(3),obrot(3,3) +!el real(kind=8) :: creff(3,nres*2),cc(3,nres*2) +!el logical :: iadded(nres) +!el integer :: inumber(2,nres) +!el common /ccc/ creff,cc,iadded,inumber + logical :: lprn + logical :: non_conv + integer :: ishif,i,j,jcon,idup,kkk,l,k,kk + real(kind=8) :: rminrms,rms + if (lprn) then + write (iout,*) "i",i," j",j," jcont",jcon," ishif",ishif + write (iout,*) "npiece",npiece(j,i) + call flush(iout) + endif +! write (iout,*) "symetr",symetr +! call flush(iout) + nperm=1 + do idup=1,symetr + nperm=nperm*idup + enddo +! write (iout,*) "nperm",nperm +! call flush(iout) + do kkk=1,nperm + idup=0 + do l=1,nres + iadded(l)=.false. + enddo +! write (iout,*) "kkk",kkk +! call flush(iout) + do k=1,npiece(j,i) + if (i.eq.1) then + if (lprn) then + write (iout,*) "Level 1: j=",j,"k=",k," adding fragment",& + ifrag(1,k,j),ifrag(2,k,j) + call flush(iout) + endif + call cprep(ifrag(1,k,j),ifrag(2,k,j),ishif,idup,kkk) +! write (iout,*) "Exit cprep" +! call flush(iout) +! write (iout,*) "ii=",ii + else + kk = ipiece(k,j,i) +! write (iout,*) "kk",kk," npiece",npiece(kk,1) + do l=1,npiece(kk,1) + if (lprn) then + write (iout,*) "Level",i,": j=",j,"k=",k," kk=",kk,& + " l=",l," adding fragment",& + ifrag(1,l,kk),ifrag(2,l,kk) + call flush(iout) + endif + call cprep(ifrag(1,l,kk),ifrag(2,l,kk),ishif,idup,kkk) +! write (iout,*) "After cprep" +! call flush(iout) + enddo + endif + enddo + enddo + if (lprn) then + write (iout,*) "tuszukaj" + do kkk=1,nperm + do k=1,idup + write(iout,'(5i4,2(3f10.5,5x))') i,j,k,inumber(1,k),& + inumber(2,k),(creff(l,k),l=1,3),(cc(l,k),l=1,3) + enddo + enddo + call flush(iout) + endif + rminrms=1.0d10 + do kkk=1,nperm + call fitsq(rms,cc(1,1),creff(1,1),idup,przes,obrot,non_conv) + if (non_conv) then + print *,'Error: FITSQ non-convergent, jcon',jcon,i + rms = 1.0d10 + else if (rms.lt.-1.0d-6) then + print *,'Error: rms^2 = ',rms,jcon,i + rms = 1.0d10 + else if (rms.ge.1.0d-6 .and. rms.lt.0) then + rms = 0.0d0 + endif +! write (iout,*) "rmsmin", rminrms, "rms", rms + if (rms.le.rminrms) rminrms=rms + enddo + rmscalc = dsqrt(rminrms) +! write (iout, *) "analysys", rmscalc,anatemp + return + end function rmscalc +!------------------------------------------------------------------------- + subroutine cprep(if1,if2,ishif,idup,kwa) + + use w_comm_local + use control_data, only:symetr + use geometry_data, only:nperm,cref,c +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.CONTROL' +! include 'COMMON.IOUNITS' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' + real(kind=8) :: przes(3),obrot(3,3) +!el real(kind=8) :: creff(3,nres*2),cc(3,nres*2) +!el logical :: iadded(nres) +!el integer :: inumber(2,nres) + integer :: iistrart,kwa,blar +!el common /ccc/ creff,cc,iadded,inumber + integer :: if1,if2,ishif,idup,kkk,l,m +! write (iout,*) "Calling cprep symetr",symetr," kwa",kwa + nperm=1 + do blar=1,symetr + nperm=nperm*blar + enddo +! write (iout,*) "nperm",nperm + kkk=kwa +! ii=0 + do l=if1,if2 +! write (iout,*) "l",l," iadded",iadded(l) +! call flush(iout) + if (l+ishif.gt.1 .and. l+ishif.le.nres .and. .not.iadded(l)) & + then + idup=idup+1 + iadded(l)=.true. + inumber(1,idup)=l + inumber(2,idup)=l+ishif + do m=1,3 + creff(m,idup)=cref(m,l,kkk) + cc(m,idup)=c(m,l+ishif) + enddo + endif + enddo + return + end subroutine cprep +!------------------------------------------------------------------------- + real(kind=8) function rmsnat(jcon) + + use control_data, only:symetr + use geometry_data, only:nperm,cref,c + use energy_data, only:itype +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.CONTROL' + real(kind=8) :: przes(3),obrot(3,3),cc(3,2*nres),ccref(3,2*nres) + logical :: non_conv + integer :: ishif,i,j,resprzesun,jcon,kkk,nnsup + real(kind=8) :: rminrms,rmsminsing,rms + rminrms=10.0d10 + rmsminsing=10d10 + nperm=1 + do i=1,symetr + nperm=nperm*i + enddo + do kkk=1,nperm + nnsup=0 + do i=1,nres + 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 + 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 + rms=1.0d10 + else if (rms.lt.-1.0d-6) then + print *,'Error: rms^2 = ',rms,jcon,i + rms = 1.0d10 + else if (rms.ge.1.0d-6 .and. rms.lt.0) then + rms=0.0d0 + endif + if (rms.le.rminrms) rminrms=rms +! write (iout,*) "kkk",kkk," rmsnat",rms , rminrms + enddo + rmsnat = dsqrt(rminrms) +! write (iout,*) "analysys",rmsnat, anatemp +! liczenie rmsdla pojedynczego lancucha + return + end function rmsnat +!------------------------------------------------------------------------------- + subroutine define_fragments + + use geometry_data, only:rad2deg + use energy_data, only:itype + use compare_data, only:nhfrag,nbfrag,bfrag,hfrag +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.TIME1' +! include 'COMMON.FRAG' +! include 'COMMON.SBRIDGE' +! include 'COMMON.CONTROL' +! include 'COMMON.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.HEADER' +! include 'COMMON.GEO' +! include 'COMMON.CONTACTS' +! include 'COMMON.PEPTCONT' +! include 'COMMON.INTERACT' +! include 'COMMON.NAMES' + integer :: nstrand,istrand(2,nres/2) + integer :: nhairp,ihairp(2,nres/5) + character(len=16) :: strstr(4)=reshape((/'helix','hairpin',& + 'strand','strand pair'/),shape(strstr)) + integer :: j,i,ii,i1,i2,i3,i4,it1,it2,it3,it4 + + write (iout,*) 'NC_FRAC_HEL',ncfrac_hel,' NC_REQ_HEL',ncreq_hel,& + 'NC_FRAC_BET',ncfrac_bet,' NC_REQ_BET',ncreq_bet,& + 'NC_FRAC_PAIR',ncfrac_pair,' NC_REQ_PAIR',ncreq_pair,& + ' RMS_PAIR',irms_pair,' SPLIT_BET',isplit_bet + write (iout,*) 'NSHIFT_HEL',nshift_hel,' NSHIFT_BET',nshift_bet,& + ' NSHIFT_STRAND',nshift_strand,' NSHIFT_PAIR',nshift_pair + write (iout,*) 'ANGCUT_HEL',angcut_hel*rad2deg,& + ' MAXANG_HEL',angcut1_hel*rad2deg + write (iout,*) 'ANGCUT_BET',angcut_bet*rad2deg,& + ' MAXANG_BET',angcut1_bet*rad2deg + write (iout,*) 'ANGCUT_STRAND',angcut_strand*rad2deg,& + ' MAXANG_STRAND',angcut1_strand*rad2deg + write (iout,*) 'FRAC_MIN',frac_min_set +! Find secondary structure elements (helices and beta-sheets) + call secondary2(.true.,.false.,ncont_pept_ref,icont_pept_ref,& + isec_ref) +! Define primary fragments. First include the helices. + nhairp=0 + nstrand=0 +! Merge helices +! AL 12/23/03 - to avoid splitting helices into very small fragments + if (merge_helices) then + write (iout,*) "Before merging helices: nhfrag",nhfrag + do i=1,nhfrag + write (2,*) hfrag(1,i),hfrag(2,i) + enddo + i=1 + do while (i.lt.nhfrag) + if (hfrag(1,i+1)-hfrag(2,i).le.1) then + nhfrag=nhfrag-1 + hfrag(2,i)=hfrag(2,i+1) + do j=i+1,nhfrag + hfrag(1,j)=hfrag(1,j+1) + hfrag(2,j)=hfrag(2,j+1) + enddo + endif + i=i+1 + enddo + write (iout,*) "After merging helices: nhfrag",nhfrag + do i=1,nhfrag + write (2,*) hfrag(1,i),hfrag(2,i) + enddo + endif + nfrag(1)=nhfrag + do i=1,nhfrag + npiece(i,1)=1 + ifrag(1,1,i)=hfrag(1,i) + ifrag(2,1,i)=hfrag(2,i) + n_shift(1,i,1)=0 + n_shift(2,i,1)=nshift_hel + ang_cut(i)=angcut_hel + ang_cut1(i)=angcut1_hel + frac_min(i)=frac_min_set + nc_fragm(i,1)=ncfrac_hel + nc_req_setf(i,1)=ncreq_hel + istruct(i)=1 + enddo + write (iout,*) "isplit_bet",isplit_bet + if (isplit_bet.gt.1) then +! Split beta-sheets into strands and store strands as primary fragments. + call split_beta(nbfrag,bfrag,nstrand,istrand,nhairp,ihairp) + do i=1,nstrand + ii=i+nfrag(1) + npiece(ii,1)=1 + ifrag(1,1,ii)=istrand(1,i) + ifrag(2,1,ii)=istrand(2,i) + n_shift(1,ii,1)=nshift_strand + n_shift(2,ii,1)=nshift_strand + ang_cut(ii)=angcut_strand + ang_cut1(ii)=angcut1_strand + frac_min(ii)=frac_min_set + nc_fragm(ii,1)=0 + nc_req_setf(ii,1)=0 + istruct(ii)=3 + enddo + nfrag(1)=nfrag(1)+nstrand + else if (isplit_bet.eq.1) then +! Split only far beta-sheets; does not split hairpins. + call find_and_remove_hairpins(nbfrag,bfrag,nhairp,ihairp) + call split_beta(nbfrag,bfrag,nstrand,istrand,nhairp,ihairp) + do i=1,nhairp + ii=i+nfrag(1) + npiece(ii,1)=1 + ifrag(1,1,ii)=ihairp(1,i) + ifrag(2,1,ii)=ihairp(2,i) + n_shift(1,ii,1)=nshift_bet + n_shift(2,ii,1)=nshift_bet + ang_cut(ii)=angcut_bet + ang_cut1(ii)=angcut1_bet + frac_min(ii)=frac_min_set + nc_fragm(ii,1)=ncfrac_bet + nc_req_setf(ii,1)=ncreq_bet + istruct(ii)=2 + enddo + nfrag(1)=nfrag(1)+nhairp + do i=1,nstrand + ii=i+nfrag(1) + npiece(ii,1)=1 + ifrag(1,1,ii)=istrand(1,i) + ifrag(2,1,ii)=istrand(2,i) + n_shift(1,ii,1)=nshift_strand + n_shift(2,ii,1)=nshift_strand + ang_cut(ii)=angcut_strand + ang_cut1(ii)=angcut1_strand + frac_min(ii)=frac_min_set + nc_fragm(ii,1)=0 + nc_req_setf(ii,1)=0 + istruct(ii)=3 + enddo + nfrag(1)=nfrag(1)+nstrand + else +! Do not split beta-sheets; each pair of strands is a primary element. + call find_and_remove_hairpins(nbfrag,bfrag,nhairp,ihairp) + do i=1,nhairp + ii=i+nfrag(1) + npiece(ii,1)=1 + ifrag(1,1,ii)=ihairp(1,i) + ifrag(2,1,ii)=ihairp(2,i) + n_shift(1,ii,1)=nshift_bet + n_shift(2,ii,1)=nshift_bet + ang_cut(ii)=angcut_bet + ang_cut1(ii)=angcut1_bet + frac_min(ii)=frac_min_set + nc_fragm(ii,1)=ncfrac_bet + nc_req_setf(ii,1)=ncreq_bet + istruct(ii)=2 + enddo + nfrag(1)=nfrag(1)+nhairp + do i=1,nbfrag + ii=i+nfrag(1) + npiece(ii,1)=2 + ifrag(1,1,ii)=bfrag(1,i) + ifrag(2,1,ii)=bfrag(2,i) + if (bfrag(3,i).lt.bfrag(4,i)) then + ifrag(1,2,ii)=bfrag(3,i) + ifrag(2,2,ii)=bfrag(4,i) + else + ifrag(1,2,ii)=bfrag(4,i) + ifrag(2,2,ii)=bfrag(3,i) + endif + n_shift(1,ii,1)=nshift_bet + n_shift(2,ii,1)=nshift_bet + ang_cut(ii)=angcut_bet + ang_cut1(ii)=angcut1_bet + frac_min(ii)=frac_min_set + nc_fragm(ii,1)=ncfrac_bet + nc_req_setf(ii,1)=ncreq_bet + istruct(ii)=4 + enddo + nfrag(1)=nfrag(1)+nbfrag + endif + write (iout,*) "The following primary fragments were found:" + write (iout,*) "Helices:",nhfrag + do i=1,nhfrag + i1=ifrag(1,1,i) + i2=ifrag(2,1,i) + it1=itype(i1) + it2=itype(i2) + write (iout,'(i3,2x,a,i4,2x,a,i4)') & + i,restyp(it1),i1,restyp(it2),i2 + enddo + write (iout,*) "Hairpins:",nhairp + do i=nhfrag+1,nhfrag+nhairp + i1=ifrag(1,1,i) + i2=ifrag(2,1,i) + it1=itype(i1) + it2=itype(i2) + write (iout,'(i3,2x,a,i4,2x,a,i4,2x)') & + i,restyp(it1),i1,restyp(it2),i2 + enddo + write (iout,*) "Far strand pairs:",nbfrag + do i=nhfrag+nhairp+1,nhfrag+nhairp+nbfrag + i1=ifrag(1,1,i) + i2=ifrag(2,1,i) + it1=itype(i1) + it2=itype(i2) + i3=ifrag(1,2,i) + i4=ifrag(2,2,i) + it3=itype(i3) + it4=itype(i4) + write (iout,'(i3,2x,a,i4,2x,a,i4," and ",a,i4,2x,a,i4)') & + i,restyp(it1),i1,restyp(it2),i2,& + restyp(it3),i3,restyp(it4),i4 + enddo + write (iout,*) "Strands:",nstrand + do i=nhfrag+nhairp+nbfrag+1,nfrag(1) + i1=ifrag(1,1,i) + i2=ifrag(2,1,i) + it1=itype(i1) + it2=itype(i2) + write (iout,'(i3,2x,a,i4,2x,a,i4)') & + i,restyp(it1),i1,restyp(it2),i2 + enddo + call imysort(nfrag(1),2,maxpiece,ifrag(1,1,1),npiece(1,1),& + istruct(1),n_shift(1,1,1),ang_cut(1),ang_cut1(1),frac_min(1),& + nc_fragm(1,1),nc_req_setf(1,1)) + write (iout,*) "Fragments after sorting:" + do i=1,nfrag(1) + i1=ifrag(1,1,i) + i2=ifrag(2,1,i) + it1=itype(i1) + it2=itype(i2) + write (iout,'(i3,2x,a,i4,2x,a,i4,$)') & + i,restyp(it1),i1,restyp(it2),i2 + if (npiece(i,1).eq.1) then + write (iout,'(2x,a)') strstr(istruct(i)) + else + i1=ifrag(1,2,i) + i2=ifrag(2,2,i) + it1=itype(i1) + it2=itype(i2) + write (iout,'(2x,a,i4,2x,a,i4,2x,a)') & + restyp(it1),i1,restyp(it2),i2,strstr(istruct(i)) + endif + enddo + return + end subroutine define_fragments +!------------------------------------------------------------------------------ + subroutine find_and_remove_hairpins(nbfrag,bfrag,nhairp,ihairp) +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' + integer :: nbfrag,bfrag(4,nres/3) + integer :: nhairp,ihairp(2,nres/5) + integer :: i,j,k + write (iout,*) "Entered find_and_remove_hairpins" + write (iout,*) "nbfrag",nbfrag + do i=1,nbfrag + write (iout,*) i,(bfrag(k,i),k=1,4) + enddo + nhairp=0 + i=1 + do while (i.le.nbfrag) + write (iout,*) "check hairpin:",i,(bfrag(j,i),j=1,4) + if (bfrag(3,i).gt.bfrag(4,i) .and. bfrag(4,i)-bfrag(2,i).lt.5) & + then + write (iout,*) "Found hairpin:",i,bfrag(1,i),bfrag(3,i) + nhairp=nhairp+1 + ihairp(1,nhairp)=bfrag(1,i) + ihairp(2,nhairp)=bfrag(3,i) + nbfrag=nbfrag-1 + do j=i,nbfrag + do k=1,4 + bfrag(k,j)=bfrag(k,j+1) + enddo + enddo + else + i=i+1 + endif + enddo + write (iout,*) "After finding hairpins:" + write (iout,*) "nhairp",nhairp + do i=1,nhairp + write (iout,*) i,ihairp(1,i),ihairp(2,i) + enddo + write (iout,*) "nbfrag",nbfrag + do i=1,nbfrag + write (iout,*) i,(bfrag(k,i),k=1,4) + enddo + return + end subroutine find_and_remove_hairpins +!------------------------------------------------------------------------------ + subroutine split_beta(nbfrag,bfrag,nstrand,istrand,nhairp,ihairp) +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' + integer :: nbfrag,bfrag(4,nres/3) + integer :: nstrand,istrand(2,nres/2) + integer :: nhairp,ihairp(2,nres/5) + logical :: found + integer :: i,k + write (iout,*) "Entered split_beta" + write (iout,*) "nbfrag",nbfrag + do i=1,nbfrag + write (iout,*) i,(bfrag(k,i),k=1,4) + enddo + nstrand=0 + do i=1,nbfrag + write (iout,*) "calling add_strand:",i,bfrag(1,i),bfrag(2,i) + call add_strand(nstrand,istrand,nhairp,ihairp,& + bfrag(1,i),bfrag(2,i),found) + if (bfrag(3,i).lt.bfrag(4,i)) then + write (iout,*) "calling add_strand:",i,bfrag(3,i),bfrag(4,i) + call add_strand(nstrand,istrand,nhairp,ihairp,& + bfrag(3,i),bfrag(4,i),found) + else + write (iout,*) "calling add_strand:",i,bfrag(4,i),bfrag(3,i) + call add_strand(nstrand,istrand,nhairp,ihairp,& + bfrag(4,i),bfrag(3,i),found) + endif + enddo + nbfrag=0 + write (iout,*) "Strands found:",nstrand + do i=1,nstrand + write (iout,*) i,istrand(1,i),istrand(2,i) + enddo + return + end subroutine split_beta +!------------------------------------------------------------------------------ + subroutine add_strand(nstrand,istrand,nhairp,ihairp,is1,is2,found) +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! include 'COMMON.IOUNITS' + integer :: nstrand,istrand(2,nres/2) + integer :: nhairp,ihairp(2,nres/5) + logical :: found + integer :: is1,is2,j,idelt + found=.false. + do j=1,nhairp + idelt=(ihairp(2,j)-ihairp(1,j))/6 + if (is1.lt.ihairp(2,j)-idelt.and.is2.gt.ihairp(1,j)+idelt) then + write (iout,*) "strand",is1,is2," is part of hairpin",& + ihairp(1,j),ihairp(2,j) + return + endif + enddo + do j=1,nstrand + idelt=(istrand(2,j)-istrand(1,j))/3 + if (is1.lt.istrand(2,j)-idelt.and.is2.gt.istrand(1,j)+idelt) & + then +! The strand already exists in the array; update its ends if necessary. + write (iout,*) "strand",is1,is2," found at position",j,& + ":",istrand(1,j),istrand(2,j) + istrand(1,j)=min0(istrand(1,j),is1) + istrand(2,j)=max0(istrand(2,j),is2) + return + endif + enddo +! The strand has not been found; add it to the array. + write (iout,*) "strand",is1,is2," added to the array." + found=.true. + nstrand=nstrand+1 + istrand(1,nstrand)=is1 + istrand(2,nstrand)=is2 + return + end subroutine add_strand +!------------------------------------------------------------------------------ + subroutine secondary2(lprint,lprint_sec,ncont,icont,isecstr) + + use geometry_data, only:anatemp,rad2deg,phi,nstart_sup,nend_sup + use energy_data, only:itype,maxcont + use compare_data, only:bfrag,hfrag,nbfrag,nhfrag + use compare, only:freeres +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'COMMON.IOUNITS' +! include 'COMMON.FRAG' +! include 'COMMON.VAR' +! include 'COMMON.GEO' +! include 'COMMON.CHAIN' +! include 'COMMON.NAMES' +! include 'COMMON.INTERACT' + integer :: ncont,icont(2,maxcont),isec(nres,4),nsec(nres),& + isecstr(nres) + logical :: lprint,lprint_sec,not_done !el,freeres + integer :: i,j,ii1,jj1,i1,j1,ij,k,ien,ist + integer :: nstrand,nbeta,nhelix,iii1,jjj1 + real(kind=8) :: p1,p2 +!rel external freeres + character(len=1) :: csec(0:2)=reshape((/'-','E','H'/),shape(csec)) + if (lprint) then + write (iout,*) "entered secondary2",ncont + write (iout,*) "nstart_sup",nstart_sup," nend_sup",nend_sup + do i=1,ncont + write (iout,*) icont(1,i),icont(2,i) + enddo + endif + do i=1,nres + isecstr(i)=0 + enddo + nbfrag=0 + nhfrag=0 + do i=1,nres + isec(i,1)=0 + isec(i,2)=0 + nsec(i)=0 + enddo + +! finding parallel beta +!d write (iout,*) '------- looking for parallel beta -----------' + nbeta=0 + nstrand=0 + do i=1,ncont + i1=icont(1,i) + j1=icont(2,i) + if (i1.ge.nstart_sup .and. i1.le.nend_sup & + .and. j1.gt.nstart_sup .and. j1.le.nend_sup) then +!d write (iout,*) "parallel",i1,j1 + if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then + ii1=i1 + jj1=j1 +!d 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 +!d 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_sec) 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 + endif ! i1.ge.nstart_sup .and. i1.le.nend_sup .and. i2.gt.nstart_sup .and. i2.le.nend_sup + enddo + +! finding antiparallel beta +!d 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 +!d 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 +!d 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) then + isec(ij,nsec(ij))=nbeta + endif + enddo + + + if (lprint_sec) 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 + +!d write (iout,*) "After beta:",nbfrag +!d do i=1,nbfrag +!d write (iout,*) (bfrag(j,i),j=1,4) +!d enddo + + if (nstrand.gt.0.and.lprint_sec) 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 + + +! 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 +!d if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2 +!o 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. + +!d write (iout,*) i1,j1,not_done,p1,p2 + enddo + j1=j1+1 + if (j1-ii1.gt.4) then + nhelix=nhelix+1 +!d 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_sec) 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_sec) 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_sec) then + write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" + write(12,'(a20)') "XMacStand ribbon.mac" + endif + + if (lprint) then + + 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),anatemp + enddo + + endif + + do j=1,nbfrag + do k=min0(bfrag(1,j),bfrag(2,j)),max0(bfrag(1,j),bfrag(2,j)) + isecstr(k)=1 + enddo + do k=min0(bfrag(3,j),bfrag(4,j)),max0(bfrag(3,j),bfrag(4,j)) + isecstr(k)=1 + enddo + enddo + do j=1,nhfrag + do k=hfrag(1,j),hfrag(2,j) + isecstr(k)=2 + enddo + enddo + if (lprint) then + write (iout,*) + write (iout,*) "Secondary structure" + do i=1,nres,80 + ist=i + ien=min0(i+79,nres) + write (iout,*) + write (iout,'(8(7x,i3))') (k,k=ist+9,ien,10) + write (iout,'(80a1)') (onelet(itype(k)),k=ist,ien) + write (iout,'(80a1)') (csec(isecstr(k)),k=ist,ien) + enddo + write (iout,*) + endif + return + end subroutine secondary2 +!------------------------------------------------- +! logical function freeres(i,j,nsec,isec) +! include 'DIMENSIONS' +! integer :: isec(nres,4),nsec(nres) +! integer :: i,j,k,l +! freeres=.false. +! +! 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 function freeres +!------------------------------------------------- + subroutine alloc_compar_arrays(nfrg,nlev) + + use energy_data, only:maxcont + use w_comm_local + integer :: nfrg,nlev + +write(iout,*) "in alloc conpar arrays: nlevel=", nlevel," nfrag(1)=",nfrag(1) +!------------------------ +! commom.contacts +! common /contacts/ + allocate(nsccont_frag_ref(mmaxfrag)) !(mmaxfrag) !wham + allocate(isccont_frag_ref(2,maxcont,mmaxfrag)) !(2,maxcont,mmaxfrag) !wham +!------------------------ +! COMMON.COMPAR +! common /compar/ + allocate(rmsfrag(nfrg,nlev+1),nc_fragm(nfrg,nlev+1)) !(maxfrag,maxlevel) + allocate(qfrag(nfrg,2)) !(maxfrag,2) + allocate(rmscutfrag(2,nfrg,nlev+1)) !(2,maxfrag,maxlevel) + allocate(ang_cut(nfrg),ang_cut1(nfrg),frac_min(nfrg)) !(maxfrag) + allocate(nc_req_setf(nfrg,nlev+1),npiece(nfrg,nlev+1),& + ielecont(nfrg,nlev+1),isccont(nfrg,nlev+1),irms(nfrg,nlev+1),& + ishifft(nfrg,nlev+1),len_frag(nfrg,nlev+1)) !(maxfrag,maxlevel) + allocate(ncont_nat(2,nfrg,nlev+1)) + allocate(n_shift(2,nfrg,nlev+1)) !(2,maxfrag,maxlevel) +! allocate(nfrag(nlev)) !(maxlevel) + allocate(isnfrag(nlev+2)) !(maxlevel+1) + allocate(ifrag(2,maxpiece,nfrg)) !(2,maxpiece,maxfrag) + allocate(ipiece(maxpiece,nfrg,2:nlev+1)) !(maxpiece,maxfrag,2:maxlevel) + allocate(istruct(nfrg),iloc(nfrg),nlist_frag(nfrg)) !(maxfrag) + allocate(iclass(nlev*nfrg,nlev+1)) !(maxlevel*maxfrag,maxlevel) + allocate(list_frag(nres,nfrg)) !(maxres,maxfrag) +!------------------------ +! COMMON.PEPTCONT +! common /peptcont/ +! integer,dimension(:,:),allocatable :: icont_pept_ref !(2,maxcont) + allocate(ncont_frag_ref(mmaxfrag)) !(mmaxfrag) + allocate(icont_frag_ref(2,maxcont,mmaxfrag)) !(2,maxcont,mmaxfrag) +! integer,dimension(:),allocatable :: isec_ref !(maxres) +!------------------------ +! module w_comm_local +! common /ccc/ + allocate(creff(3,2*nres),cc(3,2*nres)) !(3,nres*2) + allocate(iadded(nres)) !(nres) + allocate(inumber(2,nres)) !(2,nres) + + +!------------------------------------------------------------------------------- + end subroutine alloc_compar_arrays +#endif +!------------------------------------------------------------------------------- + end module conform_compar + diff --git a/source/wham/control_wham.f90 b/source/wham/control_wham.f90 new file mode 100644 index 0000000..2000e0b --- /dev/null +++ b/source/wham/control_wham.f90 @@ -0,0 +1,290 @@ + module control_wham +!----------------------------------------------------------------------------- + + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- +! initialize_p.F +!----------------------------------------------------------------------------- + subroutine init_int_table +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + use MPI_data + include 'mpif.h' +#endif +#ifdef MP +! include 'COMMON.INFO' +#endif +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.LOCAL' +! include 'COMMON.SBRIDGE' +! include 'COMMON.IOUNITS' + logical :: scheck,lprint +#ifdef MPI + integer :: my_sc_int(0:nfgtasks-1),my_ele_int(0:nfgtasks-1) + integer :: my_sc_intt(0:nfgtasks),my_ele_intt(0:nfgtasks) + +!... Determine the numbers of start and end SC-SC interaction +!... to deal with by current processor. + lprint=.true. + 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 !el ????????? + do i=1,nres + 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 +!d write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', +!d & (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 +!d write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj + if (scheck) then + if (jj.eq.i+1) then +#ifdef MPI + 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 + 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=int_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) 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 + write (iout,'(i3,2(2x,2i3))') & + i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) + enddo + endif + ispp=2 +#ifdef MPI +! 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 + ielend(i)=nct-1 + enddo +#endif + if (lprint) then + write (iout,'(a)') 'Electrostatic interaction array:' + do i=iatel_s,iatel_e + write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) + enddo + endif ! lprint +! iscp=3 + iscp=2 +! 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',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 +!d 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 +!d 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 +! 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,iphi_start,iphi_end) + iphi_start=iphi_start+nnt+2 + iphi_end=iphi_end+nnt+2 + call int_bounds(nres-3,itau_start,itau_end) + itau_start=itau_start+3 + itau_end=itau_end+3 + 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_end=nres + iphi_start=nnt+3 + iphi_end=nct + itau_start=4 + itau_end=nres +#endif + return + end subroutine init_int_table +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + end module control_wham diff --git a/source/wham/enecalc.f90 b/source/wham/enecalc.f90 new file mode 100644 index 0000000..fd5f6ca --- /dev/null +++ b/source/wham/enecalc.f90 @@ -0,0 +1,1708 @@ + module ene_calc +!----------------------------------------------------------------------------- + use io_units + use wham_data +! + use geometry_data, only:nres + use energy_data + use control_data, only:maxthetyp1 + use energy, only:etotal,enerprint,rescale_weights +#ifdef MPI + use MPI_data +! include "mpif.h" +! include "COMMON.MPI" +#endif + implicit none +!----------------------------------------------------------------------------- +! COMMON.ALLPARM +! common /allparm/ + real(kind=8),dimension(:,:),allocatable :: ww_all !(max_ene,max_parm) ! max_eneW + real(kind=8),dimension(:),allocatable :: vbldp0_all,akp_all !(max_parm) + real(kind=8),dimension(:,:,:),allocatable :: vbldsc0_all,& + aksc_all,abond0_all !(maxbondterm,ntyp,max_parm) + real(kind=8),dimension(:,:),allocatable :: a0thet_all !(-ntyp:ntyp,max_parm) + real(kind=8),dimension(:,:,:,:,:),allocatable :: athet_all,& + bthet_all !(2,-ntyp:ntyp,-1:1,-1:1,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: polthet_all !(0:3,-ntyp:ntyp,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: gthet_all !(3,-ntyp:ntyp,max_parm) + real(kind=8),dimension(:,:),allocatable :: theta0_all,& + sig0_all,sigc0_all !(-ntyp:ntyp,max_parm) + real(kind=8),dimension(:,:,:,:,:),allocatable :: aa0thet_all +!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm) + real(kind=8),dimension(:,:,:,:,:,:),allocatable :: aathet_all +!(maxtheterm,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm) + real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: bbthet_all,& + ccthet_all,ddthet_all,eethet_all !(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, +! & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm) + real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: ffthet_all1,& + ggthet_all1,ffthet_all2,ggthet_all2 !(maxdouble,maxdouble,maxtheterm3, +! & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,max_parm) + real(kind=8),dimension(:,:),allocatable :: dsc_all,dsc0_all !(ntyp1,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: bsc_all !(maxlob,ntyp,max_parm) + real(kind=8),dimension(:,:,:,:),allocatable :: censc_all !(3,maxlob,-ntyp:ntyp,max_parm) + real(kind=8),dimension(:,:,:,:,:),allocatable :: gaussc_all !(3,3,maxlob,-ntyp:ntyp,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: sc_parmin_all !(65,ntyp,max_parm) + real(kind=8),dimension(:,:,:,:),allocatable :: v0_all +!(-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + real(kind=8),dimension(:,:,:,:,:),allocatable :: v1_all,& + v2_all !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + real(kind=8),dimension(:,:,:,:),allocatable :: vlor1_all,& + vlor2_all,vlor3_all !(maxlor,maxtor,maxtor,max_parm) + real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: v1c_all,& + v1s_all !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: v2c_all +!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: v2s_all +!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: b1_all,b2_all !(2,-maxtor:maxtor,max_parm) + real(kind=8),dimension(:,:,:,:),allocatable :: cc_all,dd_all,& + ee_all !(2,2,-maxtor:maxtor,max_parm) + real(kind=8),dimension(:,:,:,:),allocatable :: ctilde_all,& + dtilde_all !(2,2,-maxtor:maxtor,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: b1tilde_all !(2,-maxtor:maxtor,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: app_all,bpp_all,& + ael6_all,ael3_all !(2,2,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: aad_all,& + bad_all !(ntyp,2,max_parm) + real(kind=8),dimension(:,:,:),allocatable :: aa_all,bb_all,& + augm_all,eps_all,sigma_all,r0_all,chi_all !(ntyp,ntyp,max_parm) + real(kind=8),dimension(:,:),allocatable :: chip_all,alp_all !(ntyp,max_parm) + real(kind=8),dimension(:),allocatable :: ebr_all,d0cm_all,& + akcm_all,akth_all,akct_all,v1ss_all,v2ss_all,v3ss_all !(max_parm) + real(kind=8),dimension(:,:,:,:,:),allocatable :: v1sccor_all,& + v2sccor_all !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm) + integer,dimension(:,:),allocatable :: nlob_all !(ntyp1,max_parm) + integer,dimension(:,:,:,:),allocatable :: nlor_all,& + nterm_all !(-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + integer,dimension(:,:,:,:,:),allocatable :: ntermd1_all,& + ntermd2_all !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + integer,dimension(:,:),allocatable :: nbondterm_all !(ntyp,max_parm) + integer,dimension(:,:),allocatable :: ithetyp_all !(-ntyp1:ntyp1,max_parm) + integer,dimension(:),allocatable :: nthetyp_all,ntheterm_all,& + ntheterm2_all,ntheterm3_all,nsingle_all,ndouble_all,& + nntheterm_all !(max_parm) + integer,dimension(:,:,:),allocatable :: nterm_sccor_all !(-ntyp:ntyp,-ntyp:ntyp,max_parm) +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- + subroutine enecalc(islice,*) + + use names + use control_data, only:indpdb + use geometry_data, only:c,phi,theta,alph,omeg,deg2rad,anatemp,& + vbld,rad2deg,dc_norm,dc,vbld_inv + use io_base, only:gyrate!,briefout + use geometry, only:int_from_cart1 + use io_wham, only:pdboutW + use io_database, only:opentmp + use conform_compar, only:qwolynes,rmsnat +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +#ifdef MPI +! use MPI_data + include "mpif.h" +! include "COMMON.MPI" +#endif +! include "COMMON.CHAIN" +! include "COMMON.IOUNITS" +! include "COMMON.PROTFILES" +! include "COMMON.NAMES" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.FFIELD" +! include "COMMON.ENEPS" +! include "COMMON.LOCAL" +! include "COMMON.WEIGHTS" +! include "COMMON.INTERACT" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.CONTROL" +! include "COMMON.TORCNSTR" +! implicit none +#ifdef MPI + integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) +#endif + character(len=64) :: nazwa + character(len=80) :: bxname + character(len=3) :: liczba +!el real(kind=8) :: qwolynes +!el external qwolynes + integer :: errmsg_count,maxerrmsg_count=100 +!el real(kind=8) :: rmsnat,gyrate +!el external rmsnat,gyrate + real(kind=8) :: tole=1.0d-1 + integer i,itj,ii,iii,j,k,l,licz + integer ir,ib,ipar,iparm + integer iscor,islice + real(kind=4) :: csingle(3,nres*2) + real(kind=8) :: energ + real(kind=8) :: temp +!el integer ilen,iroof +!el external ilen,iroof + real(kind=8) :: energia(0:n_ene),rmsdev,efree,eini +!el real(kind=8) :: energia(0:max_ene),rmsdev,efree,eini + real(kind=8) :: fT(6),quot,quotl,kfacl,kfac=2.4d0,T0=3.0d2 + real(kind=8) :: tt + integer :: snk_p(MaxR,MaxT_h,nParmSet)!Max_parm) + logical :: lerr + character(len=64) :: bprotfile_temp + +! integer :: rec + integer,dimension(0:nprocs) :: scount_ +!el real(kind=8) :: rmsnat + + rescale_mode=rescale_modeW + + call opentmp(islice,ientout,bprotfile_temp) + iii=0 + ii=0 +!el +! iparm=1 + errmsg_count=0 + write (iout,*) "enecalc: nparmset ",nparmset +#ifdef MPI + do iparm=1,nParmSet + do ib=1,nT_h(iparm) + do i=1,nR(ib,iparm) + snk_p(i,ib,iparm)=0 + enddo + enddo + enddo + do i=indstart(me1),indend(me1) +write(iout,*)"enecalc_ i indstart",i,indstart(me1),indend(me1) +#else + do iparm=1,nParmSet + do ib=1,nT_h(iparm) + do i=1,nR(ib,iparm) + snk(i,ib,iparm)=0 + enddo + enddo + enddo + do i=1,ntot +write(iout,*)"enecalc_ i ntot",i,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),& + nss,(ihpb(k),jhpb(k),k=1,nss),& + eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar +!el debug +!write(iout,*)"co wczytuje" +! write(iout,*)((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(j,iii+1),j=1,nQ),iR,ib,ipar +!el -------- + +!write(iout,*)"ipar",ib,ipar,1.0d0/(beta_h(ib,ipar)*1.987D-3) + if (indpdb.gt.0) then + do k=1,nres + do l=1,3 + c(l,k)=csingle(l,k) + enddo + enddo + do k=nnt,nct + do l=1,3 + c(l,k+nres)=csingle(l,k+nres) + enddo + enddo + anatemp= 1.0d0/(beta_h(ib,ipar)*1.987D-3) + q(nQ+1,iii+1)=rmsnat(iii+1) + endif + q(nQ+2,iii+1)=gyrate(iii+1) +! write(iout,*)"wczyt",anatemp,q(nQ+2,iii+1) !el +! fT=T0*beta_h(ib,ipar)*1.987D-3 +! ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)) +! EL start old rescale +! if (rescale_modeW.eq.1) then +! quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3) +!#if defined(FUNCTH) +! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3) +! ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0 +!#elif defined(FUNCT) +! ft(6)=quot +!#else +! ft(6)=1.0d0 +!#endif +! quotl=1.0d0 +! kfacl=1.0d0 +! do l=1,5 +! quotl=quotl*quot +! kfacl=kfacl*kfac +! fT(l)=kfacl/(kfacl-1.0d0+quotl) +! enddo +! else if (rescale_modeW.eq.2) then +! quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3) +!#if defined(FUNCTH) +! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3) +! ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0 +!#elif defined(FUNCT) +! ft(6)=quot +!#else +! ft(6)=1.0d0 +!#endif +! quotl=1.0d0 +! do l=1,5 +! quotl=quotl*quot +! fT(l)=1.12692801104297249644d0/ & +! dlog(dexp(quotl)+dexp(-quotl)) +! enddo +! else if (rescale_modeW.eq.0) then +! do l=1,5 +! fT(l)=1.0d0 +! enddo +! else +! write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",& +! rescale_modeW +! call flush(iout) +! return 1 +! endif +!EL end old rescele +! write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0, +! & " kfac",kfac,"quot",quot," fT",fT +#ifdef DEBUG + write(iout,*)"weights" + write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,& + wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,& + wtor_d,wsccor,wbond +#endif + + do j=1,2*nres + do k=1,3 + c(k,j)=csingle(k,j) + enddo + enddo + call int_from_cart1(.false.) + ii=ii+1 + +! call rescale_weights(1.0d0/(beta_h(ib,ipar)*1.987D-3)) + do iparm=1,nparmset +#ifdef DEBUG + write (iout,*) "before restore w=",1.0d0/(beta_h(ib,ipar)*1.987D-3) + write(iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,& + wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,& + wtor_d,wsccor,wbond +#endif + call restore_parm(iparm) + call rescale_weights(1.0d0/(beta_h(ib,ipar)*1.987D-3)) +#ifdef DEBUG + write (iout,*) "before etot w=",1.0d0/(beta_h(ib,ipar)*1.987D-3) + write(iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,& + wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,& + wtor_d,wsccor,wbond +#endif +! call etotal(energia(0),fT) + call etotal(energia(0)) +!write(iout,*)"check c and dc after etotal",1.0d0/(0.001987*beta_h(ib,ipar)) +!do k=1,2*nres+2 +!write(iout,*)k,"c=",(c(l,k),l=1,3) +!write(iout,*)k,"dc=",(dc(l,k),l=1,3) +!write(iout,*)k,"dc_norm=",(dc_norm(l,k),l=1,3) +!enddo +!do k=1,nres*2 +!write(iout,*)k,"vbld=",vbld(k) +!write(iout,*)k,"vbld_inv=",vbld_inv(k) +!enddo + +!write(iout,*)"energia",(energia(j),j=0,n_ene) +!write(iout,*)"enerprint tuz po call etotal" + call enerprint(energia(0)) +#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) +! call enerprint(energia(0),fT) + call enerprint(energia(0)) + write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) + write (iout,*) "ftors",ftors +!el call briefout(i,energia(0)) + temp=1.0d0/(beta_h(ib,ipar)*1.987D-3) + write (iout,*) "temp", temp + call pdboutW(i,temp,energia(0),energia(0),0.0d0,0.0d0) +#endif + if (energia(0).ge.1.0d20) then + write (iout,*) "NaNs detected in some of the energy",& + " components for conformation",ii+1 + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" +! call intout +! call pdboutW(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) + 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,*) "The components of the energy are:" +! call enerprint(energia(0),fT) + call enerprint(energia(0)) + write (iout,*) & + "This conformation WILL NOT be added to the database." + call flush(iout) + goto 121 + else +#ifdef DEBUG + if (ipar.eq.iparm) write (iout,*) i,iparm,& + 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)).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",& + iii+1,indstart(me1)+iii," T",& + 1.0d0/(1.987D-3*beta_h(ib,ipar)) +! call intout + call pdboutW(indstart(me1)+iii,& + 1.0d0/(1.987D-3*beta_h(ib,ipar)),& + energia(0),eini,0.0d0,0.0d0) + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" +! call intout +! call pdboutW(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) + 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) + call enerprint(energia(0)) +! call enerprint(energia(0),fT) + errmsg_count=errmsg_count+1 + if (errmsg_count.gt.maxerrmsg_count) & + write (iout,*) "Too many warning messages" + if (einicheck.gt.1) then + write (iout,*) "Calculation stopped." + call flush(iout) +#ifdef MPI + call MPI_Abort(WHAM_COMM,IERROR,ERRCODE) +#endif + call flush(iout) + return 1 + endif + endif + endif + potE(iii+1,iparm)=energia(0) + do k=1,21 + enetb(k,iii+1,iparm)=energia(k) + enddo +! write (iout,'(2i5,21f8.2)') "debug",k,iii+1,(enetb(k,iii+1,iparm),k=1,21) +! write (iout,*) "debug",k,iii+1,(enetb(k,iii+1,iparm),k=1,21) +#ifdef DEBUG + write (iout,'(2i5,f10.1,3e15.5)') i,iii,& + 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree +! call enerprint(energia(0),fT) +#endif +#ifdef DEBUG + 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) + 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) + write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ) + write (iout,'(f10.5,i10)') rmsdev,iscor +! call enerprint(energia(0),fT) + call enerprint(energia(0)) + call pdboutW(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) +#endif + endif + + enddo ! iparm + + iii=iii+1 + if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) q(1,iii)=qwolynes(0,0) + write (ientout,rec=iii) & + ((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),& + potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar +! write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree +#ifdef MPI + if (separate_parset) then + snk_p(iR,ib,1)=snk_p(iR,ib,1)+1 + else + snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1 + endif +! write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar, +! & " snk",snk_p(iR,ib,ipar) +#else + snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1 +#endif + 121 continue + enddo +#ifdef MPI + scount(me)=iii + write (iout,*) "Me",me," scount",scount(me) + call flush(iout) +! Master gathers updated numbers of conformations written by all procs. + call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount_(0), 1, & + MPI_INTEGER, WHAM_COMM, IERROR) + indstart(0)=1 + indend(0)=scount_(0) + do i=1, Nprocs-1 + indstart(i)=indend(i-1)+1 + indend(i)=indstart(i)+scount_(i)-1 + enddo + write (iout,*) + write (iout,*) "Revised conformation counts" + do i=0,nprocs1-1 + write (iout,'(a,i5,a,i7,a,i7,a,i7)') & + "Processor",i," indstart",indstart(i),& + " indend",indend(i)," count",scount_(i) + enddo + call flush(iout) + call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),& + MaxR*MaxT_h*nParmSet,& + MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR) +#endif + stot(islice)=0 + do iparm=1,nParmSet + do ib=1,nT_h(iparm) + do i=1,nR(ib,iparm) + stot(islice)=stot(islice)+snk(i,ib,iparm,islice) + enddo + enddo + enddo + write (iout,*) "Revised SNK" + do iparm=1,nParmSet + do ib=1,nT_h(iparm) + write (iout,'("Param",i3," Temp",f6.1,3x,32i8)') & + iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),& + (snk(i,ib,iparm,islice),i=1,nR(ib,iparm)) + write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm)) + enddo + enddo + write (iout,'("Total",i10)') stot(islice) + call flush(iout) + do i=0,nprocs + scount(i)=scount_(i) + enddo + return + 101 write (iout,*) "Error in scratchfile." + call flush(iout) +!el#undef DEBUG + return 1 + end subroutine enecalc +!------------------------------------------------------------------------------ + logical function conf_check(ii,iprint) + + use geometry_data, only:c,phi,theta,alph,omeg,deg2rad,rad2deg,vbld + use geometry, only:int_from_cart1 +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +#ifdef MPI +! use MPI_data + include "mpif.h" +! include "COMMON.MPI" +#endif +! include "COMMON.CHAIN" +! include "COMMON.IOUNITS" +! include "COMMON.PROTFILES" +! include "COMMON.NAMES" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.FFIELD" +! include "COMMON.ENEPS" +! include "COMMON.LOCAL" +! include "COMMON.WEIGHTS" +! include "COMMON.INTERACT" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.CONTROL" +! include "COMMON.TORCNSTR" +! implicit none +#ifdef MPI + integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) +#endif + integer :: j,k,l,ii,itj,iprint + if (.not.check_conf) then + conf_check=.true. + return + endif + call int_from_cart1(.false.) + do j=nnt+1,nct + if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and. & + (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then + if (iprint.gt.0) & + write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),& + " for conformation",ii + if (iprint.gt.1) then + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + endif + if (iprint.gt.0) write (iout,*) & + "This conformation WILL NOT be added to the database." + conf_check=.false. + return + endif + enddo + do j=nnt,nct + itj=itype(j) + 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 + if (iprint.gt.1) then + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + endif + if (iprint.gt.0) write (iout,*) & + "This conformation WILL NOT be added to the database." + conf_check=.false. + return + endif + enddo + do j=3,nres + if (theta(j).le.0.0d0) then + if (iprint.gt.0) & + write (iout,*) "Zero theta angle(s) in conformation",ii + if (iprint.gt.1) then + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + endif + if (iprint.gt.0) write (iout,*) & + "This conformation WILL NOT be added to the database." + conf_check=.false. + return + endif + if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad + enddo + conf_check=.true. +! write (iout,*) "conf_check passed",ii + return + end function conf_check +!----------------------------------------------------------------------------- +! store_parm.F +!----------------------------------------------------------------------------- + subroutine store_parm(iparm) +! +! Store parameters of set IPARM +! valence angles and the side chains and energy parameters. +! +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.FREE' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.GEO' +! include 'COMMON.LOCAL' +! include 'COMMON.TORSION' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' +! include 'COMMON.SBRIDGE' +! include 'COMMON.SCROT' +! include 'COMMON.SCCOR' +! include 'COMMON.ALLPARM' + integer :: i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii + + call alloc_enecalc_arrays(iparm) +!el allocate(ww_all(n_ene,iparm)) +! Store weights + ww_all(1,iparm)=wsc + ww_all(2,iparm)=wscp + ww_all(3,iparm)=welec + ww_all(4,iparm)=wcorr + ww_all(5,iparm)=wcorr5 + ww_all(6,iparm)=wcorr6 + ww_all(7,iparm)=wel_loc + ww_all(8,iparm)=wturn3 + ww_all(9,iparm)=wturn4 + ww_all(10,iparm)=wturn6 + ww_all(11,iparm)=wang + ww_all(12,iparm)=wscloc + ww_all(13,iparm)=wtor + ww_all(14,iparm)=wtor_d + ww_all(15,iparm)=wstrain + ww_all(16,iparm)=wvdwpp + ww_all(17,iparm)=wbond + ww_all(19,iparm)=wsccor +! Store bond parameters + vbldp0_all(iparm)=vbldp0 + akp_all(iparm)=akp + do i=1,ntyp + nbondterm_all(i,iparm)=nbondterm(i) + do j=1,nbondterm(i) + vbldsc0_all(j,i,iparm)=vbldsc0(j,i) + aksc_all(j,i,iparm)=aksc(j,i) + abond0_all(j,i,iparm)=abond0(j,i) + enddo + enddo +! Store bond angle parameters +#ifdef CRYST_THETA + 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,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) + enddo + do j=1,3 + gthet_all(j,i,iparm)=gthet(j,i) + enddo + theta0_all(i,iparm)=theta0(i) + sig0_all(i,iparm)=sig0(i) + sigc0_all(i,iparm)=sigc0(i) + enddo +#else + nthetyp_all(iparm)=nthetyp + ntheterm_all(iparm)=ntheterm + ntheterm2_all(iparm)=ntheterm2 + ntheterm3_all(iparm)=ntheterm3 + nsingle_all(iparm)=nsingle + ndouble_all(iparm)=ndouble + nntheterm_all(iparm)=nntheterm + do i=-ntyp,ntyp + ithetyp_all(i,iparm)=ithetyp(i) + enddo + 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,iblock,iparm)=aathet(l,i,j,k,iblock) + enddo + do l=1,ntheterm2 + do m=1,nsingle + 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 + 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 +! Store the sidechain rotamer parameters + do i=-ntyp,ntyp + iii=iabs(i) +!! 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 + do k=1,3 + do l=1,3 + gaussc_all(l,k,j,i,iparm)=gaussc(l,k,j,i) + enddo + enddo + enddo + enddo +#else + do i=1,ntyp + do j=1,65 + sc_parmin_all(j,i,iparm)=sc_parmin(j,i) + enddo + enddo +#endif +! Store the torsional parameters + 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,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 +! Store the double torsional parameters + 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,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 +! Store parameters of the cumulants + do i=-nloctyp,nloctyp + 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) + 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) + enddo + enddo + enddo +! Store the parameters of electrostatic interactions + do i=1,2 + do j=1,2 + app_all(j,i,iparm)=app(j,i) + bpp_all(j,i,iparm)=bpp(j,i) + ael6_all(j,i,iparm)=ael6(j,i) + ael3_all(j,i,iparm)=ael3(j,i) + enddo + enddo +! 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) + 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) + enddo + enddo + do i=1,ntyp + chip_all(i,iparm)=chip(i) + alp_all(i,iparm)=alp(i) + enddo +! Store the SCp parameters + do i=1,ntyp + do j=1,2 + aad_all(i,j,iparm)=aad(i,j) + bad_all(i,j,iparm)=bad(i,j) + enddo + enddo +! Store disulfide-bond parameters + ebr_all(iparm)=ebr + d0cm_all(iparm)=d0cm + akcm_all(iparm)=akcm + akth_all(iparm)=akth + akct_all(iparm)=akct + v1ss_all(iparm)=v1ss + v2ss_all(iparm)=v2ss + v3ss_all(iparm)=v3ss +! Store SC-backbone correlation parameters + do i=-nsccortyp,nsccortyp + do j=-nsccortyp,nsccortyp + + nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i) +! do i=1,20 +! 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 +write(iout,*)"end of store_parm" + return + end subroutine store_parm +!-------------------------------------------------------------------------- + subroutine restore_parm(iparm) +! +! Store parameters of set IPARM +! valence angles and the side chains and energy parameters. +! +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.FREE' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.GEO' +! include 'COMMON.LOCAL' +! include 'COMMON.TORSION' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' +! include 'COMMON.SBRIDGE' +! include 'COMMON.SCROT' +! include 'COMMON.SCCOR' +! include 'COMMON.ALLPARM' + integer :: i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii + +! Restore weights + wsc=ww_all(1,iparm) + wscp=ww_all(2,iparm) + welec=ww_all(3,iparm) + wcorr=ww_all(4,iparm) + wcorr5=ww_all(5,iparm) + wcorr6=ww_all(6,iparm) + wel_loc=ww_all(7,iparm) + wturn3=ww_all(8,iparm) + wturn4=ww_all(9,iparm) + wturn6=ww_all(10,iparm) + wang=ww_all(11,iparm) + wscloc=ww_all(12,iparm) + wtor=ww_all(13,iparm) + wtor_d=ww_all(14,iparm) + wstrain=ww_all(15,iparm) + wvdwpp=ww_all(16,iparm) + wbond=ww_all(17,iparm) + wsccor=ww_all(19,iparm) +! Restore bond parameters + vbldp0=vbldp0_all(iparm) + akp=akp_all(iparm) + do i=1,ntyp + nbondterm(i)=nbondterm_all(i,iparm) + do j=1,nbondterm(i) + vbldsc0(j,i)=vbldsc0_all(j,i,iparm) + aksc(j,i)=aksc_all(j,i,iparm) + abond0(j,i)=abond0_all(j,i,iparm) + enddo + enddo +! Restore bond angle parameters +#ifdef CRYST_THETA + 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,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) + enddo + do j=1,3 + gthet(j,i)=gthet_all(j,i,iparm) + enddo + theta0(i)=theta0_all(i,iparm) + sig0(i)=sig0_all(i,iparm) + sigc0(i)=sigc0_all(i,iparm) + enddo +#else + nthetyp=nthetyp_all(iparm) + ntheterm=ntheterm_all(iparm) + ntheterm2=ntheterm2_all(iparm) + ntheterm3=ntheterm3_all(iparm) + nsingle=nsingle_all(iparm) + ndouble=ndouble_all(iparm) + nntheterm=nntheterm_all(iparm) + do i=-ntyp,ntyp + ithetyp(i)=ithetyp_all(i,iparm) + enddo + 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,iblock)=aathet_all(l,i,j,k,iblock,iparm) + enddo + do l=1,ntheterm2 + do m=1,nsingle + 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 + 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 +! Restore the sidechain rotamer parameters +#ifdef CRYST_SC + 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 + do k=1,3 + do l=1,3 + gaussc(l,k,j,i)=gaussc_all(l,k,j,i,iparm) + enddo + enddo + enddo + enddo +#else + do i=1,ntyp + do j=1,65 + sc_parmin(j,i)=sc_parmin_all(j,i,iparm) + enddo + enddo +#endif +! Restore the torsional parameters + 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,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 +! Restore the double torsional parameters + 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,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 +! Restore parameters of the cumulants + do i=-nloctyp,nloctyp + 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) + 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) + enddo + enddo + enddo +! Restore the parameters of electrostatic interactions + do i=1,2 + do j=1,2 + app(j,i)=app_all(j,i,iparm) + bpp(j,i)=bpp_all(j,i,iparm) + ael6(j,i)=ael6_all(j,i,iparm) + ael3(j,i)=ael3_all(j,i,iparm) + enddo + enddo +! 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) + 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) + enddo + enddo + do i=1,ntyp + chip(i)=chip_all(i,iparm) + alp(i)=alp_all(i,iparm) + enddo +! Restore the SCp parameters + do i=1,ntyp + do j=1,2 + aad(i,j)=aad_all(i,j,iparm) + bad(i,j)=bad_all(i,j,iparm) + enddo + enddo +! Restore disulfide-bond parameters + ebr=ebr_all(iparm) + d0cm=d0cm_all(iparm) + akcm=akcm_all(iparm) + akth=akth_all(iparm) + akct=akct_all(iparm) + v1ss=v1ss_all(iparm) + v2ss=v2ss_all(iparm) + v3ss=v3ss_all(iparm) +! Restore SC-backbone correlation parameters + 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 + return + end subroutine restore_parm +!-------------------------------------------------------------------------- +! make_ensemble1.F +!-------------------------------------------------------------------------- + subroutine make_ensembles(islice,*) +! construct the conformational ensembles at REMD temperatures + use geometry_data, only:c + use io_base, only:ilen + use io_wham, only:pdboutW +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +#ifdef MPI + include "mpif.h" +! include "COMMON.MPI" + integer :: ierror,errcode,status(MPI_STATUS_SIZE) +#endif +! include "COMMON.IOUNITS" +! include "COMMON.CONTROL" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.FFIELD" +! include "COMMON.INTERACT" +! include "COMMON.SBRIDGE" +! include "COMMON.CHAIN" +! include "COMMON.PROTFILES" +! include "COMMON.PROT" + real(kind=4) :: csingle(3,nres*2) + real(kind=8),dimension(6) :: fT,fTprim,fTbis + real(kind=8) :: quot,quotl1,quotl,kfacl,& + eprim,ebis,temper,kfac=2.4d0,T0=300.0d0 + real(kind=8) :: etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors,& + escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,& + eello_turn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,tt + integer :: i,ii,ik,iproc,iscor,j,k,l,ib,iparm,iprot,nlist + real(kind=8) :: qfree,sumprob,eini,efree,rmsdev + character(len=80) :: bxname + character(len=2) :: licz1,licz2 + character(len=3) :: licz3,licz4 + character(len=5) :: ctemper +!el integer ilen +!el external ilen + real(kind=4) :: Fdimless(MaxStr),Fdimless_(MaxStr) + real(kind=8) :: enepot(MaxStr) + integer :: iperm(MaxStr) + integer :: islice + integer,dimension(0:nprocs) :: scount_ + +#ifdef MPI + if (me.eq.Master) then +#endif + write (licz2,'(bz,i2.2)') islice + if (nslice.eq.1) then + if (.not.separate_parset) then + bxname = prefix(:ilen(prefix))//".bx" + else + write (licz3,'(bz,i3.3)') myparm + bxname = prefix(:ilen(prefix))//"_par"//licz3//".bx" + endif + else + if (.not.separate_parset) then + bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx" + else + write (licz3,'(bz,i3.3)') myparm + bxname = prefix(:ilen(prefix))//"par_"//licz3// & + "_slice_"//licz2//".bx" + endif + endif + open (ientout,file=bxname,status="unknown",& + form="unformatted",access="direct",recl=lenrec1) +#ifdef MPI + endif +#endif + do iparm=1,iparm + if (iparm.ne.iparmprint) exit + call restore_parm(iparm) + do ib=1,nT_h(iparm) +#ifdef DEBUG + write (iout,*) "iparm",iparm," ib",ib +#endif + temper=1.0d0/(beta_h(ib,iparm)*1.987D-3) +! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3) +! quotl=1.0d0 +! kfacl=1.0d0 +! do l=1,5 +! quotl1=quotl +! quotl=quotl*quot +! kfacl=kfacl*kfac +! fT(l)=kfacl/(kfacl-1.0d0+quotl) +! enddo +!el old rescale weights +! +! if (rescale_mode.eq.1) then +! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3) +#if defined(FUNCTH) + tt=1.0d0/(beta_h(ib,iparm)*1.987D-3) + ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/320.0d0 +#elif defined(FUNCT) + ft(6)=quot +#else + ft(6)=1.0d0 +#endif +! quotl=1.0d0 +! kfacl=1.0d0 +! do l=1,5 +! quotl1=quotl +! quotl=quotl*quot +! kfacl=kfacl*kfac +! fT(l)=kfacl/(kfacl-1.0d0+quotl) +! enddo +! else if (rescale_mode.eq.2) then +! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3) +!#if defined(FUNCTH) +! tt=1.0d0/(beta_h(ib,iparm)*1.987D-3) +! ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/3200.d0 +!#elif defined(FUNCT) +! ft(6)=quot +!#else +! ft(6)=1.0d0 +!#endif +! quotl=1.0d0 +! do l=1,5 +! quotl=quotl*quot +! fT(l)=1.12692801104297249644d0/ & +! dlog(dexp(quotl)+dexp(-quotl)) +! enddo +! write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft +! else if (rescale_mode.eq.0) then +! do l=1,5 +! fT(l)=0.0d0 +! enddo +! else +! write (iout,*) & +! "Error in MAKE_ENSEMBLE: Wrong RESCALE_MODE:",rescale_mode +! call flush(iout) +! return 1 +! endif +! el end old rescale weihgts + call rescale_weights(1.0d0/(beta_h(ib,iparm)*1.987D-3)) + +#ifdef MPI + do i=1,scount(me1) +#else + do i=1,ntot(islice) +#endif + evdw=enetb(1,i,iparm) +! evdw_t=enetb(21,i,iparm) + evdw_t=enetb(20,i,iparm) +#ifdef SCP14 +! evdw2_14=enetb(17,i,iparm) + evdw2_14=enetb(18,i,iparm) + evdw2=enetb(2,i,iparm)+evdw2_14 +#else + evdw2=enetb(2,i,iparm) + evdw2_14=0.0d0 +#endif +#ifdef SPLITELE + ees=enetb(3,i,iparm) + evdw1=enetb(16,i,iparm) +#else + ees=enetb(3,i,iparm) + evdw1=0.0d0 +#endif + ecorr=enetb(4,i,iparm) + ecorr5=enetb(5,i,iparm) + ecorr6=enetb(6,i,iparm) + eel_loc=enetb(7,i,iparm) + eello_turn3=enetb(8,i,iparm) + eello_turn4=enetb(9,i,iparm) + eello_turn6=enetb(10,i,iparm) + ebe=enetb(11,i,iparm) + escloc=enetb(12,i,iparm) + etors=enetb(13,i,iparm) + etors_d=enetb(14,i,iparm) + ehpb=enetb(15,i,iparm) + + estr=enetb(17,i,iparm) +! estr=enetb(18,i,iparm) +! esccor=enetb(19,i,iparm) + esccor=enetb(21,i,iparm) +! edihcnstr=enetb(20,i,iparm) + edihcnstr=enetb(19,i,iparm) +!#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 +!#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 +!#endif + +#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*eello_turn6+wel_loc*eel_loc & + +edihcnstr+wtor_d*etors_d+wsccor*esccor & + +wbond*estr +#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*eello_turn6+wel_loc*eel_loc+edihcnstr & + +wtor_d*etors_d+wsccor*esccor & + +wbond*estr +#endif + +#ifdef MPI + Fdimless(i)= & + beta_h(ib,iparm)*etot-entfac(i) + potE(i,iparm)=etot +#ifdef DEBUG + write (iout,*) i,indstart(me)+i-1,ib,& + 1.0d0/(1.987d-3*beta_h(ib,iparm)),potE(i,iparm),& + -entfac(i),Fdimless(i) +#endif +#else + Fdimless(i)=beta_h(ib,iparm)*etot-entfac(i) + potE(i,iparm)=etot +#endif + enddo ! i +#ifdef MPI + do i=1,scount(me1) + Fdimless_(i)=Fdimless(i) + enddo + call MPI_Gatherv(Fdimless_(1),scount(me),& + MPI_REAL,Fdimless(1),& + scount_(0),idispl(0),MPI_REAL,Master,& + WHAM_COMM, IERROR) +#ifdef DEBUG + call MPI_Gatherv(potE(1,iparm),scount_(me),& + MPI_DOUBLE_PRECISION,potE(1,iparm),& + scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master,& + WHAM_COMM, IERROR) + call MPI_Gatherv(entfac(1),scount(me),& + MPI_DOUBLE_PRECISION,entfac(1),& + scount_(0),idispl(0),MPI_DOUBLE_PRECISION,Master,& + WHAM_COMM, IERROR) +#endif + if (me.eq.Master) then +#ifdef DEBUG + write (iout,*) "The FDIMLESS array before sorting" + do i=1,ntot(islice) + write (iout,*) i,fdimless(i) + enddo +#endif +#endif + do i=1,ntot(islice) + iperm(i)=i + enddo + call mysort1(ntot(islice),Fdimless,iperm) +#ifdef DEBUG + write (iout,*) "The FDIMLESS array after sorting" + do i=1,ntot(islice) + write (iout,*) i,iperm(i),fdimless(i) + enddo +#endif + qfree=0.0d0 + do i=1,ntot(islice) + qfree=qfree+exp(-fdimless(i)+fdimless(1)) + enddo +! write (iout,*) "qfree",qfree + nlist=1 + sumprob=0.0 + do i=1,min0(ntot(islice),ensembles) + sumprob=sumprob+exp(-fdimless(i)+fdimless(1))/qfree +#ifdef DEBUG + write (iout,*) i,ib,beta_h(ib,iparm),& + 1.0d0/(1.987d-3*beta_h(ib,iparm)),iperm(i),& + potE(iperm(i),iparm),& + -entfac(iperm(i)),fdimless(i),sumprob +#endif + if (sumprob.gt.0.99d0) goto 122 + nlist=nlist+1 + enddo + 122 continue +#ifdef MPI + endif + call MPI_Bcast(nlist, 1, MPI_INTEGER, Master, WHAM_COMM,& + IERROR) + call MPI_Bcast(iperm,nlist,MPI_INTEGER,Master,WHAM_COMM,& + IERROR) + do i=1,nlist + ii=iperm(i) + iproc=0 + do while (ii.lt.indstart(iproc).or.ii.gt.indend(iproc)) + iproc=iproc+1 + enddo + if (iproc.ge.nprocs) then + write (iout,*) "Fatal error: processor out of range",iproc + call flush(iout) + if (bxfile) then + close (ientout) + else + close (ientout,status="delete") + endif + return 1 + endif + ik=ii-indstart(iproc)+1 + if (iproc.ne.Master) then + if (me.eq.iproc) then +#ifdef DEBUG + write (iout,*) "i",i," ii",ii," iproc",iproc," ik",ik,& + " energy",potE(ik,iparm) +#endif + call MPI_Send(potE(ik,iparm),1,MPI_DOUBLE_PRECISION,& + Master,i,WHAM_COMM,IERROR) + else if (me.eq.Master) then + call MPI_Recv(enepot(i),1,MPI_DOUBLE_PRECISION,iproc,i,& + WHAM_COMM,STATUS,IERROR) + endif + else if (me.eq.Master) then + enepot(i)=potE(ik,iparm) + endif + enddo +#else + do i=1,nlist + enepot(i)=potE(iperm(i),iparm) + enddo +#endif +#ifdef MPI + if (me.eq.Master) then +#endif + write(licz3,'(bz,i3.3)') iparm + write(licz2,'(bz,i2.2)') islice + if (temper.lt.100.0d0) then + write(ctemper,'(f3.0)') temper + else if (temper.lt.1000.0) then + write (ctemper,'(f4.0)') temper + else + write (ctemper,'(f5.0)') temper + endif + if (nparmset.eq.1) then + if (separate_parset) then + write(licz4,'(bz,i3.3)') myparm + pdbname=prefix(:ilen(prefix))//"_par"//licz4 + else + pdbname=prefix(:ilen(prefix)) + endif + else + pdbname=prefix(:ilen(prefix))//"_parm_"//licz3 + endif + if (nslice.eq.1) then + pdbname=pdbname(:ilen(pdbname))//"_T_"// & + ctemper(:ilen(ctemper))//"pdb" + else + pdbname=pdbname(:ilen(pdbname))//"_slice_"//licz2//"_T_"// & + ctemper(:ilen(ctemper))//"pdb" + endif + open(ipdb,file=pdbname) + do i=1,nlist + read (ientout,rec=iperm(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 + do j=1,2*nres + do k=1,3 + c(k,j)=csingle(k,j) + enddo + enddo + eini=fdimless(i) + call pdboutW(iperm(i),temper,eini,enepot(i),efree,rmsdev) + enddo +#ifdef MPI + endif +#endif + enddo ! ib + enddo ! iparm + if (bxfile) then + close(ientout) + else + close(ientout,status="delete") + endif + do i=0,nprocs + scount(i)=scount_(i) + enddo + return + end subroutine make_ensembles +!-------------------------------------------------------------------------- + subroutine mysort1(n, x, ipermut) +! implicit none + integer :: i,j,imax,ipm,n + real(kind=4) :: x(n) + integer :: ipermut(n) + real(kind=4) :: xtemp + do i=1,n + xtemp=x(i) + imax=i + do j=i+1,n + if (x(j).lt.xtemp) then + imax=j + xtemp=x(j) + endif + enddo + x(imax)=x(i) + x(i)=xtemp + ipm=ipermut(imax) + ipermut(imax)=ipermut(i) + ipermut(i)=ipm + enddo + return + end subroutine mysort1 +!-------------------------------------------------------------------------- + subroutine alloc_enecalc_arrays(iparm) + + use control_data + use geometry_data, only:maxlob + integer :: iparm +!--------------------------- +! COMMON.ENERGIES form wham_data +! common /energies/ + allocate(potE(MaxStr_Proc,iparm)) !(MaxStr_Proc,Max_Parm) + allocate(entfac(MaxStr_Proc)) !(MaxStr_Proc) + allocate(q(nQ+2,MaxStr_Proc)) !(MaxQ+2,MaxStr_Proc) + allocate(enetb(max_ene,MaxStr_Proc,iparm)) !(max_ene,MaxStr_Proc,Max_Parm) +! +! allocate ENECALC arrays +!--------------------------- +! COMMON.ALLPARM +! common /allparm/ + allocate(ww_all(max_eneW,iparm)) !(max_ene,max_parm) ! max_eneW + allocate(vbldp0_all(iparm),akp_all(nParmSet)) !(max_parm) + allocate(vbldsc0_all(maxbondterm,ntyp,iparm),& + aksc_all(maxbondterm,ntyp,iparm),& + abond0_all(maxbondterm,ntyp,iparm)) !(maxbondterm,ntyp,max_parm) + allocate(a0thet_all(-ntyp:ntyp,iparm)) !(-ntyp:ntyp,max_parm) + allocate(athet_all(2,-ntyp:ntyp,-1:1,-1:1,iparm),& + bthet_all(2,-ntyp:ntyp,-1:1,-1:1,iparm)) !(2,-ntyp:ntyp,-1:1,-1:1,max_parm) + allocate(polthet_all(0:3,-ntyp:ntyp,iparm)) !(0:3,-ntyp:ntyp,max_parm) + allocate(gthet_all(3,-ntyp:ntyp,iparm)) !(3,-ntyp:ntyp,max_parm) + allocate(theta0_all(-ntyp:ntyp,iparm),& + sig0_all(-ntyp:ntyp,iparm),sigc0_all(-ntyp:ntyp,nParmSet)) !(-ntyp:ntyp,max_parm) + allocate(aa0thet_all(-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm)) +!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm) + allocate(aathet_all(maxtheterm,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm)) +!(maxtheterm,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm) + allocate(bbthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm)) + allocate(ccthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm)) + allocate(ddthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm)) + allocate(eethet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm)) +!(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, +! & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm) + allocate(ffthet_all1(maxdouble,maxdouble,maxtheterm3,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,iparm)) + allocate(ggthet_all1(maxdouble,maxdouble,maxtheterm3,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,iparm)) + allocate(ffthet_all2(maxdouble,maxdouble,maxtheterm3,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,iparm)) + allocate(ggthet_all2(maxdouble,maxdouble,maxtheterm3,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,iparm)) +!(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,& +!-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,max_parm) + allocate(dsc_all(ntyp1,iparm),dsc0_all(ntyp1,nParmSet)) !(ntyp1,max_parm) + allocate(bsc_all(maxlob,ntyp,iparm)) +!(maxlob,ntyp,max_parm) + allocate(censc_all(3,maxlob,-ntyp:ntyp,iparm)) !(3,maxlob,-ntyp:ntyp,max_parm) + allocate(gaussc_all(3,3,maxlob,-ntyp:ntyp,iparm)) !(3,3,maxlob,-ntyp:ntyp,max_parm) + allocate(sc_parmin_all(65,ntyp,iparm)) !(65,ntyp,max_parm) + allocate(v0_all(-maxtor:maxtor,-maxtor:maxtor,2,iparm)) +!(-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(v1_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,iparm)) + allocate(v2_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,iparm)) +!(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(vlor1_all(maxlor,maxtor,maxtor,iparm)) + allocate(vlor2_all(maxlor,maxtor,maxtor,iparm)) + allocate(vlor3_all(maxlor,maxtor,maxtor,iparm)) !(maxlor,maxtor,maxtor,max_parm) + allocate(v1c_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,& + -maxtor:maxtor,2,iparm)) + allocate(v1s_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,& + -maxtor:maxtor,2,iparm)) +!(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(v2c_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,& + -maxtor:maxtor,-maxtor:maxtor,2,iparm)) +!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(v2s_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,& + -maxtor:maxtor,-maxtor:maxtor,2,iparm)) +!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(b1_all(2,-maxtor:maxtor,iparm)) + allocate(b2_all(2,-maxtor:maxtor,iparm)) !(2,-maxtor:maxtor,max_parm) + allocate(cc_all(2,2,-maxtor:maxtor,iparm)) + allocate(dd_all(2,2,-maxtor:maxtor,iparm)) + allocate(ee_all(2,2,-maxtor:maxtor,iparm)) !(2,2,-maxtor:maxtor,max_parm) + allocate(ctilde_all(2,2,-maxtor:maxtor,iparm)) + allocate(dtilde_all(2,2,-maxtor:maxtor,iparm)) !(2,2,-maxtor:maxtor,max_parm) + allocate(b1tilde_all(2,-maxtor:maxtor,iparm)) !(2,-maxtor:maxtor,max_parm) + allocate(app_all(2,2,iparm),bpp_all(2,2,nParmSet),& + ael6_all(2,2,iparm),ael3_all(2,2,nParmSet)) !(2,2,max_parm) + allocate(aad_all(ntyp,2,iparm),bad_all(ntyp,2,nParmSet)) !(ntyp,2,max_parm) + allocate(aa_all(ntyp,ntyp,iparm),bb_all(ntyp,ntyp,nParmSet),& + augm_all(ntyp,ntyp,iparm),eps_all(ntyp,ntyp,nParmSet),& + sigma_all(ntyp,ntyp,iparm),r0_all(ntyp,ntyp,nParmSet),& + chi_all(ntyp,ntyp,iparm)) !(ntyp,ntyp,max_parm) + allocate(chip_all(ntyp,iparm),alp_all(ntyp,nParmSet)) !(ntyp,max_parm) + allocate(ebr_all(iparm),d0cm_all(nParmSet),akcm_all(nParmSet),& + akth_all(iparm),akct_all(nParmSet),v1ss_all(nParmSet),& + v2ss_all(iparm),v3ss_all(nParmSet)) !(max_parm) + allocate(v1sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,iparm)) + allocate(v2sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,iparm)) +!(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm) + allocate(nlob_all(ntyp1,iparm)) !(ntyp1,max_parm) + allocate(nlor_all(-maxtor:maxtor,-maxtor:maxtor,2,iparm)) + allocate(nterm_all(-maxtor:maxtor,-maxtor:maxtor,2,iparm)) +!(-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(ntermd1_all(-maxtor:maxtor,-maxtor:maxtor,& + -maxtor:maxtor,2,iparm)) + allocate(ntermd2_all(-maxtor:maxtor,-maxtor:maxtor,& + -maxtor:maxtor,2,iparm)) +!(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm) + allocate(nbondterm_all(ntyp,iparm)) !(ntyp,max_parm) + allocate(ithetyp_all(-ntyp1:ntyp1,iparm)) !(-ntyp1:ntyp1,max_parm) + allocate(nthetyp_all(iparm),ntheterm_all(nParmSet),& + ntheterm2_all(iparm),ntheterm3_all(nParmSet),& + nsingle_all(iparm),& + ndouble_all(iparm),nntheterm_all(nParmSet)) !(max_parm) + allocate(nterm_sccor_all(-ntyp:ntyp,-ntyp:ntyp,iparm)) !(-ntyp:ntyp,-ntyp:ntyp,max_parm) +! + end subroutine alloc_enecalc_arrays +!-------------------------------------------------------------------------- +!-------------------------------------------------------------------------- + end module ene_calc diff --git a/source/wham/io_database.f90 b/source/wham/io_database.f90 new file mode 100644 index 0000000..13d4f37 --- /dev/null +++ b/source/wham/io_database.f90 @@ -0,0 +1,1488 @@ + module io_database +!----------------------------------------------------------------------------- + use names + use wham_data + use io_units + use io_base, only:ilen + use energy_data, only:nnt,nct,nss,ihpb,jhpb,iset + use geometry_data, only:nres,c +#ifdef MPI + use MPI_data +! include "COMMON.MPI" +#endif + + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- +! readrtns.F +!------------------------------------------------------------------------------- + subroutine opentmp(islice,iunit,bprotfile_temp) +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +! use MPI_data, only:me +#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(len=64) :: bprotfile_temp + character(len=3) :: liczba,liczba2 + character(len=2) :: liczba1 + integer :: iunit,islice +! integer ilen,iroof +! external ilen,iroof +! logical :: lerr +! integer :: lenrec,lenrec2 + +!el +! lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ +! lenrec=lenrec2+8 + write (liczba1,'(bz,i2.2)') islice +#ifdef MPI + write (liczba,'(bz,i3.3)') me +!#ifdef MPI +! write (iout,*) "separate_parset ",separate_parset, +! & " 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 +! write (iout,*) "OpenTmp iunit",iunit," bprotfile_temp", +! & bprotfile_temp +! call flush(iout) + return + end subroutine opentmp +!------------------------------------------------------------------------------- + subroutine read_database(*) + +! use energy_data, only:nct,nnt,nss +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" + use MPI_data, only:me,nprocs +#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(kind=4) :: csingle(3,nres*2) !(3,maxres2) + character(len=64) :: nazwa,bprotfile_temp + character(len=3) :: liczba + character(len=2) :: liczba1 + integer :: i,j,ii,jj(nslice),k,kk(nslice),l,& + ll(nslice),mm(nslice),if + integer :: nrec,nlines,iscor,iunit,islice + real(kind=8) :: energ +! integer ilen,iroof +! external ilen,iroof + real(kind=8) :: rmsdev,energia(0:n_ene),efree,eini,temp +!el real(kind=8) :: rmsdev,energia(0:max_eneW),efree,eini,temp + real(kind=8) :: prop(nQ) !(maxQ) + integer :: ntot_all(nslice,0:nprocs-1)!(maxslice,0:maxprocs-1) + integer :: iparm,ib,iib,ir,nprop,nthr,npars + real(kind=8) :: 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 + + do i=1,nQ + prop(i)=0.0d0 + enddo + do islice=1,nslice + ll(islice)=0 + mm(islice)=0 + enddo + 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 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 +! Read conformations from binary DA files (one per batch) and write them to +! 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,islice,ii,jj(islice),kk(islice),ll(islice),& + mm(islice),iR,ib,iparm) + close(ientout) + enddo + close(ientin) + enddo + ENDIF ! NFILE_BIN>0 +! + IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN +! Read conformations from multiple ASCII int files and write them to a binary +! 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 +! Read conformations from cx files and write them to a binary +! 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) +write(iout,*)"after call cxread" + close(ientout) + write (iout,*) "exit cxread" + call flush(iout) + enddo + ENDIF +write(iout,*)"*********************in read database" + + do islice=1,nslice +! stot(islice)=0 + 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 +! Check if everyone has the same number of conformations + call MPI_Allgather(stot(1),nslice,MPI_INTEGER,& + ntot_all(1,0),nslice,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) + return 1 + endif + do islice=1,nslice + ntot(islice)=stot(islice) + enddo +write(iout,*) "end of read database" + return +#endif + 1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa)) + call flush(iout) + return 1 + end subroutine read_database +!-------------------------------------------------------------------------------- + integer function iroof(n,m) + integer :: n,m,ii + ii = n/m + if (ii*m .lt. n) ii=ii+1 + iroof = ii + return + end function iroof +!-------------------------------------------------------------------------------- +! bxread.F +!-------------------------------------------------------------------------------- + subroutine bxread(nazwa,islice,ii,jj,kk,ll,mm,iR,ib,iparm) +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +! use energy_data, only:nnt,nct,nss,ihpb,jhpbi + use MPI_data, only:nprocs +#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" + real(kind=4) :: csingle(3,nres*2) !(3,maxres2) + character(len=64) :: nazwa,bprotfile_temp + character(len=3) :: liczba + integer :: i,is,ie,j,ii,jj,k,kk,l,ll,mm,if + integer :: nrec,nlines,iscor,islice + real(kind=8) :: energ +! integer ilen,iroof +! external ilen,iroof + real(kind=8) :: rmsdev,energia(0:n_ene),efree,eini,temp +!el real(kind=8) :: rmsdev,energia(0:max_eneW),efree,eini,temp + real(kind=8) :: prop(nQ) !(maxQ) + integer :: ntot_all(0:nprocs-1)!(0:maxprocs-1) + integer :: iparm,ib,iib,ir,nprop,nthr,nrec_slice + real(kind=8) :: etot,time + logical :: lerr + nrec_slice=(rec_end(iR,ib,iparm)-rec_start(iR,ib,iparm)+1)/nslice + is=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice + ie=rec_start(iR,ib,iparm)+islice*nrec_slice-1 + write (iout,*) "bxread: islice",islice," nslice",nslice,& + " nrec_slice",nrec_slice + write (iout,*) "is",is," ie",ie,"rec_start",& + rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm) + do i=is,ie + read(ientin,rec=i+1,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,(prop(j),j=1,nQ),iscor + ii=ii+1 + kk=kk+1 + if (mod(kk,isampl(iparm)).eq.0) then + jj=jj+1 + write(ientout,rec=jj) & + ((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,(prop(j),j=1,nQ),iR,ib,iparm +#ifdef DEBUG + do i=1,2*nres + do j=1,3 + c(j,i)=csingle(j,i) + 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,*) "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) + write (iout,'(f10.5,i5)') rmsdev,iscor +#endif + endif + enddo + 101 continue + close(ientin) + write (iout,*) ii," conformations read from DA file ",& + nazwa(:ilen(nazwa)) + write (iout,*) kk," conformations read so far, slice",islice + write (iout,*) jj," conformations stored so far, slice",islice + + return + end subroutine bxread +!-------------------------------------------------------------------------------- +! cxread.F +!-------------------------------------------------------------------------------- + subroutine cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,*) + +#define DEBUG +#ifdef DEBUG + use geometry, only:int_from_cart1 + use geometry_data, only:vbld,rad2deg,theta,phi,alph,omeg + integer :: iscor +#endif +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.FREE' + integer,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(len=64) :: nazwa,bprotfile_temp + real(kind=4) :: rtime,rpotE,ruconst,rt_bath,rprop(nQ) !(2000) !(maxQ) + real(kind=8) :: time + integer :: iret,itmp,itraj,ntraj + real(kind=4) :: xoord(3,2*nres+2),prec + integer :: nstep(0:MaxTraj-1) +! integer ilen +! external ilen + integer :: ii,jj(nslice),kk(nslice),ll(nslice),mm(nslice) !(maxslice) + integer :: is(nSlice),ie(nSlice),nrec_slice + real(kind=8) :: ts(nSlice),te(nSlice),time_slice + integer :: iR,ib,iparm,i,j,it,islice,nprop_prev + integer :: k,l,iib,islice1,nprop + real(kind=8) :: efree,rmsdev + integer :: ixdrf +!el integer :: slice +! logical :: conf_check +! ixdrf=0 +! nprop=0 + +! ruconst=0.0d0 +! rtime=0.0d0 +! rpotE=0.0d0 +! rt_bath=0.0d0 + + call set_slices(is,ie,ts,te,iR,ib,iparm) + nprop_prev=0 + 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) return 1 + + islice1=1 + call opentmp(islice1,ientout,bprotfile_temp) + print *,"bumbum" !d + do while (iret.gt.0) + +#if (defined(AIX) && !defined(JUBL)) + call xdrffloat_(ixdrf, rtime, iret) + print *,"rtime",rtime," iret",iret !d + call xdrffloat_(ixdrf, rpotE, iret) + write (iout,*) "rpotE",rpotE," iret",iret !d + 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) + 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 + call xdrffloat(ixdrf, rtime, iret) + call xdrffloat(ixdrf, rpotE, iret) + write (iout,*) "rpotE",rpotE," iret",iret !d + 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) + enddo + call xdrfint(ixdrf, nprop, iret) + write (iout,*) "nprop",nprop !d + 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 + call flush(iout) + 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 +#endif + if (iret.eq.0) exit + itraj=mod(it,totraj(iR,iparm)) +#define DEBUG +#ifdef DEBUG + write (iout,*) "ii",ii," itraj",itraj," it",it +#endif + if (iset.eq.0) iset = 1 + call flush(iout) + it=it+1 + if (itraj.gt.ntraj) ntraj=itraj + nstep(itraj)=nstep(itraj)+1 +! rprop(2)=dsqrt(rprop(2)) +! 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,2*nres+2) +#endif +#undef DEBUG + 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 + write (iout,*) "calling slice" !d + call flush(iout) !d + islice=slice(nstep(itraj),time,is,ie,ts,te) + write (iout,*) "islice",islice !d + call flush(iout) !d + + 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 + + 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 + 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) +! exit +! 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 + 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 +! if (replica(iparm)) then +! write (iout,*) "TEMP",1.0d0/(rt_bath*1.987D-3) +! write (iout,*) "TEMP list" +! write (iout,*) +! & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) +! endif + write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ +! write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss +! write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 + call flush(iout) +#endif + if (islice.ne.islice1) then +! write (iout,*) "islice",islice," islice1",islice1 + close(ientout) +! write (iout,*) "Closing file ", +! & bprotfile_temp(:ilen(bprotfile_temp)) + call opentmp(islice,ientout,bprotfile_temp) +! write (iout,*) "Opening file ", +! & 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) +! 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) +#undef DEBUG + return + end subroutine cxread +!-------------------------------------------------------------------------------- +! xread.F +!-------------------------------------------------------------------------------- + subroutine xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm) + + use geometry_data +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" + use MPI_data, only:nprocs +#ifdef MPI + include "mpif.h" + integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) +! include "COMMON.MPI" +#endif + integer,parameter :: MaxTraj=2050 +! 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(kind=4) :: csingle(3,nres*2) + character(len=64) :: nazwa,bprotfile_temp + integer :: i,j,k,l,ii,jj(nslice),kk(nslice),ll(nslice),& + mm(nslice) !(maxslice) + integer :: iscor,islice,islice1 !el,slice + real(kind=8) :: energ +! integer ilen,iroof +! external ilen,iroof + real(kind=8) :: rmsdev,energia(0:n_ene),efree,eini,temp +!el real(kind=8) :: rmsdev,energia(0:max_eneW),efree,eini,temp + real(kind=8) :: prop(nQ) !(maxQ) + integer :: ntot_all(0:nprocs-1)!(0:maxprocs-1) + integer :: iparm,ib,iib,ir,nprop,nthr + real(kind=8) :: etot,time,ts(nslice),te(nslice) + integer :: is(nslice),ie(nslice),itraj,ntraj,it,iset + integer :: nstep(0:MaxTraj-1) + logical :: lerr + + call set_slices(is,ie,ts,te,iR,ib,iparm) + do i=1,nQ + prop(i)=0.0d0 + enddo + do i=0,MaxTraj-1 + nstep(i)=0 + enddo + ntraj=0 + it=0 + islice1=1 + call opentmp(islice1,ientout,bprotfile_temp) + do while (.true.) + if (replica(iparm)) then + if (hamil_rep .or. umbrella(iparm)) then + read (ientin,*,end=1112,err=1112) time,eini,& + etot,temp,nss,(ihpb(j),jhpb(j),j=1,nss),& + nprop,(prop(j),j=1,nprop),iset + else + read (ientin,*,end=1112,err=1112) time,eini,& + etot,temp,nss,(ihpb(j),jhpb(j),j=1,nss),& + nprop,(prop(j),j=1,nprop) + endif + temp=1.0d0/(temp*1.987D-3) +! write (iout,*) time,eini,etot,nss, +! & (ihpb(j),jhpb(j),j=1,nss),(prop(j),j=1,nprop) +! call flush(iout) + do i=1,nT_h(iparm) + if (beta_h(i,iparm).eq.temp) 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/(temp*1.987D-3),& + " does not match any of the list" + write (iout,*) & + 1.0d0/(temp*1.987D-3),& + (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) + call flush(iout) +#ifdef MPI + call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) +#endif + endif + else + read (ientin,*,end=1112,err=1112) time,eini,& + etot,nss,(ihpb(j),jhpb(j),j=1,nss),& + nprop,(prop(j),j=1,nprop) + iib = ib + endif + itraj=mod(it,totraj(iR,iparm)) +! write (*,*) "ii",ii," itraj",itraj +! call flush(iout) + it=it+1 + if (itraj.gt.ntraj) ntraj=itraj + nstep(itraj)=nstep(itraj)+1 + islice=slice(nstep(itraj),time,is,ie,ts,te) + read (ientin,'(8f10.5)',end=1112,err=1112) & + ((csingle(l,k),l=1,3),k=1,nres),& + ((csingle(l,k+nres),l=1,3),k=nnt,nct) + efree=0.0d0 + if (islice.gt.0 .and. islice.le.nslice) then + ii=ii+1 + kk(islice)=kk(islice)+1 + mm(islice)=mm(islice)+1 + if (mod(nstep(itraj),isampl(iparm)).eq.0) then + jj(islice)=jj(islice)+1 + if (hamil_rep) then + snk(iR,iib,iset,islice)=snk(iR,iib,iset,islice)+1 + else if (umbrella(iparm)) then + snk(iset,iib,iparm,islice)=snk(iset,iib,iparm,islice)+1 + else + snk(iR,iib,iparm,islice)=snk(iR,iib,iparm,islice)+1 + endif + ll(islice)=ll(islice)+1 +! write (iout,*) ii,kk,jj,ll,eini,(prop(j),j=1,nprop) +#ifdef DEBUG +! write (iout,*) "Writing conformation, record",ll(islice) +! write (iout,*) "ib",ib," iib",iib + if (replica(iparm)) then + write (iout,*) "TEMP",1.0d0/(temp*1.987D-3) + write (iout,*) "TEMP list" + write (iout,*) & + (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) + endif + call flush(iout) +#endif +! write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ +! write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss +! write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 +! call flush(iout) + if (islice.ne.islice1) then +! write (iout,*) "islice",islice," islice1",islice1 + close(ientout) +! write (iout,*) "Closing file ", +! & bprotfile_temp(:ilen(bprotfile_temp)) + call opentmp(islice,ientout,bprotfile_temp) +! write (iout,*) "Opening file ", +! & bprotfile_temp(:ilen(bprotfile_temp)) +! call flush(iout) + islice1=islice + endif + write(ientout,rec=ll(islice)) & + ((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,(prop(i),i=1,nQ),iR,iib,iparm +#ifdef DEBUG + do i=1,2*nres + do j=1,3 + c(j,i)=csingle(j,i) + enddo + enddo + 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) +! write (iout,'(8f10.5)') (prop(j),j=1,nQ) + write (iout,'(16i5)') iscor + call flush(iout) +#endif + endif + endif + enddo + 1112 continue + close(ientout) + 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)) + write (iout,*) mm(islice)," conformations read so far, slice",& + islice + write (iout,*) ll(islice)," conformations stored so far, slice",& + islice + call flush(iout) + return + end subroutine xread +!-------------------------------------------------------------------------------- +! enecalc1.F +!-------------------------------------------------------------------------------- + subroutine write_dbase(islice,*) + + use geometry_data + use control_data, only:indpdb + use w_compar_data + use conform_compar, only:conf_compar +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +! include "DIMENSIONS.COMPAR" + use geometry, only:int_from_cart1 +#ifdef MPI + include "mpif.h" + integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) +! include "COMMON.MPI" +#endif +! include "COMMON.CONTROL" +! include "COMMON.CHAIN" +! include "COMMON.IOUNITS" +! include "COMMON.PROTFILES" +! include "COMMON.NAMES" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.FFIELD" +! include "COMMON.ENEPS" +! include "COMMON.LOCAL" +! include "COMMON.WEIGHTS" +! include "COMMON.INTERACT" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.COMPAR" +! include "COMMON.PROT" +! include "COMMON.CONTACTS1" + character(len=64) :: nazwa + character(len=80) :: bxname,cxname + character(len=64) :: bprotfile_temp + character(len=3) :: liczba,licz + character(len=2) :: licz2 + integer :: i,itj,ii,iii,j,k,l + integer :: ixdrf,iret + integer :: iscor,islice + real(kind=8) :: rmsdev,efree,eini + real(kind=4) :: csingle(3,nres*2) + real(kind=8) :: energ +! integer ilen,iroof +! external ilen,iroof + integer :: ir,ib,iparm + integer :: isecstr(nres) + write (licz2,'(bz,i2.2)') islice + call opentmp(islice,ientout,bprotfile_temp) + write (iout,*) "bprotfile_temp ",bprotfile_temp + call flush(iout) + if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0 & + .and. ensembles.eq.0) then + close(ientout,status="delete") + return + endif +#ifdef MPI + write (liczba,'(bz,i3.3)') me + if (bxfile .or. cxfile .or. ensembles.gt.0) then + if (.not.separate_parset) then + bxname = prefix(:ilen(prefix))//liczba//".bx" + else + write (licz,'(bz,i3.3)') myparm + bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx" + endif + open (ientin,file=bxname,status="unknown",& + form="unformatted",access="direct",recl=lenrec1) + endif +#else + if (bxfile .or. cxfile .or. ensembles.gt.0) then + if (nslice.eq.1) then + bxname = prefix(:ilen(prefix))//".bx" + else + bxname = prefix(:ilen(prefix))// & + "_slice_"//licz2//".bx" + endif + open (ientin,file=bxname,status="unknown",& + form="unformatted",access="direct",recl=lenrec1) + write (iout,*) "Calculating energies; writing geometry",& + " and energy components to ",bxname(:ilen(bxname)) + endif +#if (defined(AIX) && !defined(JUBL)) + call xdrfopen_(ixdrf,cxname, "w", iret) +#else + call xdrfopen(ixdrf,cxname, "w", iret) +#endif + if (iret.eq.0) then + write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname)) + cxfile=.false. + endif +!el endif +#endif + if (indpdb.gt.0) then + if (nslice.eq.1) then +#ifdef MPI + if (.not.separate_parset) then + statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot)) & + //liczba//'.stat' + else + write (licz,'(bz,i3.3)') myparm + statname=prefix(:ilen(prefix))//'_par'//licz//'_'// & + pot(:ilen(pot))//liczba//'.stat' + endif + +#else + statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat' +#endif + else +#ifdef MPI + if (.not.separate_parset) then + statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))// & + "_slice_"//licz2//liczba//'.stat' + else + write (licz,'(bz,i3.3)') myparm + statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))// & + '_par'//licz//"_slice_"//licz2//liczba//'.stat' + endif +#else + statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot)) & + //"_slice_"//licz2//'.stat' +#endif + endif + open(istat,file=statname,status="unknown") + endif + +#ifdef MPI + do i=1,scount(me) +#else + do i=1,ntot(islice) +#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),& + nss,(ihpb(k),jhpb(k),k=1,nss),& + eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm +! write (iout,*) iR,ib,iparm,eini,efree + do j=1,2*nres + do k=1,3 + c(k,j)=csingle(k,j) + enddo + enddo + call int_from_cart1(.false.) + iscore=0 +! write (iout,*) "Calling conf_compar",i +! call flush(iout) + anatemp= 1.0d0/(beta_h(ib,iparm)*1.987D-3) + if (indpdb.gt.0) then + call conf_compar(i,.false.,.true.) +! else +! call elecont(.false.,ncont,icont,nnt,nct) +! call secondary2(.false.,.false.,ncont,icont,isecstr) + endif +! write (iout,*) "Exit conf_compar",i +! call flush(iout) + 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),& +! & potE(i,iparm),-entfac(i),rms_nat,iscore + potE(i,nparmset),-entfac(i),rms_nat,iscore +! 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) +#endif + enddo + close(ientout,status="delete") + close(istat) + if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin) +#ifdef MPI + call MPI_Barrier(WHAM_COMM,IERROR) + if (me.ne.Master .or. .not.bxfile .and. .not. cxfile & + .and. ensembles.eq.0) return + write (iout,*) + if (bxfile .or. ensembles.gt.0) then + if (nslice.eq.1) then + if (.not.separate_parset) then + bxname = prefix(:ilen(prefix))//".bx" + else + write (licz,'(bz,i3.3)') myparm + bxname = prefix(:ilen(prefix))//"_par"//licz//".bx" + endif + else + if (.not.separate_parset) then + bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx" + else + write (licz,'(bz,i3.3)') myparm + bxname = prefix(:ilen(prefix))//"par_"//licz// & + "_slice_"//licz2//".bx" + endif + endif + open (ientout,file=bxname,status="unknown",& + form="unformatted",access="direct",recl=lenrec1) + write (iout,*) "Master is creating binary database ",& + bxname(:ilen(bxname)) + endif + if (cxfile) then + if (nslice.eq.1) then + if (.not.separate_parset) then + cxname = prefix(:ilen(prefix))//".cx" + else + cxname = prefix(:ilen(prefix))//"_par"//licz//".cx" + endif + else + if (.not.separate_parset) then + cxname = prefix(:ilen(prefix))// & + "_slice_"//licz2//".cx" + else + cxname = prefix(:ilen(prefix))//"_par"//licz// & + "_slice_"//licz2//".cx" + endif + endif +#if (defined(AIX) && !defined(JUBL)) + call xdrfopen_(ixdrf,cxname, "w", iret) +#else + call xdrfopen(ixdrf,cxname, "w", iret) +#endif + if (iret.eq.0) then + write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname)) + cxfile=.false. + endif + endif + do j=0,nprocs-1 + write (liczba,'(bz,i3.3)') j + if (separate_parset) then + write (licz,'(bz,i3.3)') myparm + bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx" + else + bxname = prefix(:ilen(prefix))//liczba//".bx" + endif + open (ientin,file=bxname,status="unknown",& + form="unformatted",access="direct",recl=lenrec1) + write (iout,*) "Master is reading conformations from ",& + bxname(:ilen(bxname)) + iii = 0 +! write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j) +! call flush(iout) + do i=indstart(j),indend(j) + iii = iii+1 + 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 + if (bxfile .or. ensembles.gt.0) then + 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 + endif + if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor) +#ifdef DEBUG + do k=1,2*nres + do l=1,3 + c(l,k)=csingle(l,k) + enddo + enddo + call int_from_cart1(.false.) + write (iout,'(2i5,3e15.5)') i,iii,eini,efree + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + write (iout,'(f10.5,i5)') rmsdev,iscor +#endif + enddo ! i + write (iout,*) iii," conformations (from",indstart(j)," to",& + indend(j),") read from ",& + bxname(:ilen(bxname)) + close (ientin,status="delete") + enddo ! j + if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout) +#if (defined(AIX) && !defined(JUBL)) + if (cxfile) call xdrfclose_(ixdrf,cxname,iret) +#else + if (cxfile) call xdrfclose(ixdrf,cxname,iret) +#endif +#endif + return + 101 write (iout,*) "Error in scratchfile." + call flush(iout) + return 1 + end subroutine write_dbase +!------------------------------------------------------------------------------- + subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor) +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +! include "DIMENSIONS.COMPAR" +#ifdef MPI + include "mpif.h" + integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) +! include "COMMON.MPI" +#endif +! include "COMMON.CONTROL" +! include "COMMON.CHAIN" +! include "COMMON.IOUNITS" +! include "COMMON.PROTFILES" +! include "COMMON.NAMES" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.FFIELD" +! include "COMMON.ENEPS" +! include "COMMON.LOCAL" +! include "COMMON.WEIGHTS" +! include "COMMON.INTERACT" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.COMPAR" +! include "COMMON.PROT" + integer :: i,j,itmp,iscor,iret,ixdrf + real(kind=8) :: rmsdev,efree,eini + real(kind=4) :: csingle(3,nres*2),xoord(3,2*nres+2) + real(kind=4) :: prec + +! write (iout,*) "cxwrite" +! call flush(iout) + prec=10000.0 + do i=1,nres + do j=1,3 + xoord(j,i)=csingle(j,i) + enddo + enddo + do i=nnt,nct + do j=1,3 + xoord(j,nres+i-nnt+1)=csingle(j,i+nres) + enddo + enddo + + itmp=nres+nct-nnt+1 + +! write (iout,*) "itmp",itmp +! call flush(iout) +#if (defined(AIX) && !defined(JUBL)) + call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret) + +! write (iout,*) "xdrf3dfcoord" +! call flush(iout) + call xdrfint_(ixdrf, nss, iret) + do j=1,nss + call xdrfint_(ixdrf, ihpb(j), iret) + call xdrfint_(ixdrf, jhpb(j), iret) + enddo + call xdrffloat_(ixdrf,real(eini),iret) + call xdrffloat_(ixdrf,real(efree),iret) + call xdrffloat_(ixdrf,real(rmsdev),iret) + call xdrfint_(ixdrf,iscor,iret) +#else + call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret) + + call xdrfint(ixdrf, nss, iret) + do j=1,nss + call xdrfint(ixdrf, ihpb(j), iret) + call xdrfint(ixdrf, jhpb(j), iret) + enddo + call xdrffloat(ixdrf,real(eini),iret) + call xdrffloat(ixdrf,real(efree),iret) + call xdrffloat(ixdrf,real(rmsdev),iret) + call xdrfint(ixdrf,iscor,iret) +#endif + + return + end subroutine cxwrite +!------------------------------------------------------------------------------- +! slices.F +!------------------------------------------------------------------------------- + subroutine set_slices(is,ie,ts,te,iR,ib,iparm) +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.FREE' +! include 'COMMON.IOUNITS' +! include 'COMMON.PROTFILES' +! include 'COMMON.OBCINKA' +! include 'COMMON.PROT' + integer :: islice,iR,ib,iparm + integer :: is(MaxSlice),ie(MaxSlice),nrec_slice + real(kind=8) :: ts(MaxSlice),te(MaxSlice),time_slice + + do islice=1,nslice + if (time_end_collect(iR,ib,iparm).ge.1.0d10) then + ts(islice)=time_start_collect(iR,ib,iparm) + te(islice)=time_end_collect(iR,ib,iparm) + nrec_slice=(rec_end(iR,ib,iparm)- & + rec_start(iR,ib,iparm)+1)/nslice + is(islice)=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice + ie(islice)=rec_start(iR,ib,iparm)+islice*nrec_slice-1 + else + time_slice=(time_end_collect(iR,ib,iparm) & + -time_start_collect(iR,ib,iparm))/nslice + ts(islice)=time_start_collect(iR,ib,iparm)+(islice-1)* & + time_slice + te(islice)=time_start_collect(iR,ib,iparm)+islice*time_slice + is(islice)=rec_start(iR,ib,iparm) + ie(islice)=rec_end(iR,ib,iparm) + endif + enddo + + write (iout,*) "nrec_slice",nrec_slice," time_slice",time_slice + write (iout,*) "is",(is(islice),islice=1,nslice) + write (iout,*) "ie",(ie(islice),islice=1,nslice) + write (iout,*) "rec_start",& + rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm) + write (iout,*) "ts",(ts(islice),islice=1,nslice) + write (iout,*) "te",(te(islice),islice=1,nslice) + write (iout,*) "time_start",& + time_start_collect(iR,ib,iparm)," time_end",& + time_end_collect(iR,ib,iparm) + call flush(iout) + + return + end subroutine set_slices +!----------------------------------------------------------------------------- + integer function slice(irecord,time,is,ie,ts,te) +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.FREE' +! include 'COMMON.IOUNITS' +! include 'COMMON.PROTFILES' +! include 'COMMON.OBCINKA' +! include 'COMMON.PROT' + integer :: is(MaxSlice),ie(MaxSlice),nrec_slice + real(kind=8) :: ts(MaxSlice),te(MaxSlice),time_slice + integer :: i,ii,irecord + real(kind=8) :: time + +! write (iout,*) "within slice nslice",nslice +! call flush(iout) + if (irecord.lt.is(1) .or. time.lt.ts(1)) then + ii=0 + else + ii=1 + do while (ii.le.nslice .and. & + (irecord.lt.is(ii) .or. irecord.gt.ie(ii) .or. & + time.lt.ts(ii) .or. time.gt.te(ii)) ) +! write (iout,*) "ii",ii,time,ts(ii) +! call flush(iout) + ii=ii+1 + enddo + endif +! write (iout,*) "end: ii",ii +! call flush(iout) + slice=ii + return + end function slice +!----------------------------------------------------------------------------- +! enecalc1.F +!----------------------------------------------------------------------------- + logical function conf_check(ii,iprint) + + use names, only:ntyp1 + use geometry_data + use energy_data, only:itype,dsc + use geometry, only:int_from_cart1 +! use +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +!#ifdef MPI +! use MPI_data +! include "mpif.h" +! include "COMMON.MPI" +!#endif +! include "COMMON.CHAIN" +! include "COMMON.IOUNITS" +! include "COMMON.PROTFILES" +! include "COMMON.NAMES" +! include "COMMON.VAR" +! include "COMMON.SBRIDGE" +! include "COMMON.GEO" +! include "COMMON.FFIELD" +! include "COMMON.ENEPS" +! include "COMMON.LOCAL" +! include "COMMON.WEIGHTS" +! include "COMMON.INTERACT" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.CONTROL" +! include "COMMON.TORCNSTR" +! implicit none +#ifdef MPI + include "mpif.h" + integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) +#endif + integer :: j,k,l,ii,itj,iprint + if (.not. check_conf) then + conf_check=.true. + return + endif + call int_from_cart1(.false.) + do j=nnt+1,nct + if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and. & + (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then + if (iprint.gt.0) & + write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),& + " for conformation",ii + if (iprint.gt.1) then + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + endif + if (iprint.gt.0) write (iout,*) & + "This conformation WILL NOT be added to the database." + conf_check=.false. + return + endif + enddo + do j=nnt,nct + itj=itype(j) + 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 + if (iprint.gt.1) then + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + endif + if (iprint.gt.0) write (iout,*) & + "This conformation WILL NOT be added to the database." + conf_check=.false. + return + endif + enddo + do j=3,nres + if (theta(j).le.0.0d0) then + if (iprint.gt.0) & + write (iout,*) "Zero theta angle(s) in conformation",ii + if (iprint.gt.1) then + write (iout,*) "The Cartesian geometry is:" + 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) + write (iout,*) "The internal geometry is:" + 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) + endif + if (iprint.gt.0) write (iout,*) & + "This conformation WILL NOT be added to the database." + conf_check=.false. + return + endif + if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad + enddo + conf_check=.true. +! write (iout,*) "conf_check passed",ii + return + end function conf_check +!----------------------------------------------------------------------------- + end module io_database diff --git a/source/wham/io_wham.f90 b/source/wham/io_wham.f90 new file mode 100644 index 0000000..eaea35f --- /dev/null +++ b/source/wham/io_wham.f90 @@ -0,0 +1,2764 @@ + module io_wham + + use io_units + use io_base + use wham_data +#ifndef CLUSTER + use w_compar_data +#endif +! use geometry_data +! use geometry + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- +! openunits.F +!----------------------------------------------------------------------------- +#ifndef CLUSTER + subroutine openunits +#ifdef WIN + use dfport +#endif +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + use MPI_data + include 'mpif.h' +! include 'COMMON.MPI' +! integer :: MyRank + character(len=3) :: liczba +#endif +! include 'COMMON.IOUNITS' + integer :: lenpre,lenpot !,ilen +!el external ilen + +#ifdef MPI + MyRank=Me +#endif + call mygetenv('PREFIX',prefix) + call mygetenv('SCRATCHDIR',scratchdir) + call mygetenv('POT',pot) + lenpre=ilen(prefix) + lenpot=ilen(pot) + call mygetenv('POT',pot) + entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr' +! Get the names and open the input files + open (1,file=prefix(:ilen(prefix))//'.inp',status='old') +! Get parameter filenames and open the parameter files. + call mygetenv('BONDPAR',bondname) + open (ibond,file=bondname,status='old') + call mygetenv('THETPAR',thetname) + open (ithep,file=thetname,status='old') + call mygetenv('ROTPAR',rotname) + open (irotam,file=rotname,status='old') + call mygetenv('TORPAR',torname) + open (itorp,file=torname,status='old') + call mygetenv('TORDPAR',tordname) + open (itordp,file=tordname,status='old') + call mygetenv('FOURIER',fouriername) + open (ifourier,file=fouriername,status='old') + call mygetenv('SCCORPAR',sccorname) + open (isccor,file=sccorname,status='old') + call mygetenv('ELEPAR',elename) + open (ielep,file=elename,status='old') + call mygetenv('SIDEPAR',sidename) + open (isidep,file=sidename,status='old') + call mygetenv('SIDEP',sidepname) + open (isidep1,file=sidepname,status="old") +#ifndef OLDSCP +! +! 8/9/01 In the newest version SCp interaction constants are read from a file +! Use -DOLDSCP to use hard-coded constants instead. +! + call mygetenv('SCPPAR',scpname) + open (iscpp,file=scpname,status='old') +#endif +#ifdef MPL + if (MyID.eq.BossID) then + MyRank = MyID/fgProcs +#endif +#ifdef MPI + print *,'OpenUnits: processor',MyRank + call numstr(MyRank,liczba) + outname=prefix(:lenpre)//'.out_'//pot(:lenpot)//liczba +#else + outname=prefix(:lenpre)//'.out_'//pot(:lenpot) +#endif + open(iout,file=outname,status='unknown') + write (iout,'(80(1h-))') + write (iout,'(30x,a)') "FILE ASSIGNMENT" + write (iout,'(80(1h-))') + write (iout,*) "Input file : ",& + prefix(:ilen(prefix))//'.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,*) "Backbone-rotamer 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,'(80(1h-))') + write (iout,*) + return + end subroutine openunits +!----------------------------------------------------------------------------- +! molread_zs.F +!----------------------------------------------------------------------------- + subroutine molread(*) +! +! Read molecular data. +! + use energy_data + use geometry_data, only:nres,deg2rad,c,dc + use control_data, only:iscode + use control, only:rescode,setup_var,init_int_table + use geometry, only:alloc_geo_arrays + use energy, only:alloc_ener_arrays +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! 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.TORCNSTR' +! include 'COMMON.CONTROL' + character(len=4),dimension(:),allocatable :: sequence !(nres) +!el integer :: rescode +!el real(kind=8) :: x(maxvar) + character(len=320) :: controlcard !,ucase + integer,dimension(nres) :: itype_pdb !(maxres) + integer :: i,j,i1,i2,it1,it2 + real(kind=8) :: scalscp +!el logical :: seq_comp + 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,'TEMP0',temp0,300.0d0) !el + call reada(controlcard,'DELT_CORR',delt_corr,0.5d0) + r0_corr=cutoff_corr-delt_corr + call readi(controlcard,"NRES",nres,0) + allocate(sequence(nres+1)) +!el znamy juz ilosc reszt wiec mozna zaalokowac tablice do liczenia enerii + call alloc_geo_arrays + call alloc_ener_arrays +! alokacja dodatkowych tablic, ktore w unresie byly alokowanie w locie +!---------------------------- + allocate(c(3,2*nres+2)) + allocate(dc(3,0:2*nres+2)) + allocate(itype(nres+2)) + allocate(itel(nres+2)) +! +! Zero out tableis. + do i=1,2*nres+2 + do j=1,3 + c(j,i)=0.0D0 + dc(j,i)=0.0D0 + enddo + enddo + do i=1,nres+2 + itype(i)=0 + itel(i)=0 + enddo +!-------------------------- +! + iscode=index(controlcard,"ONE_LETTER") + if (nres.le.0) then + write (iout,*) "Error: no residues in molecule" + return 1 + endif + if (nres.gt.maxres) then + write (iout,*) "Error: too many residues",nres,maxres + endif + write(iout,*) 'nres=',nres +! Read sequence of the protein + 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 +! Convert sequence to numeric code + do i=1,nres + itype(i)=rescode(i,sequence(i),iscode) + enddo + write (iout,*) "Numeric code:" + write (iout,'(20i4)') (itype(i),i=1,nres) + do i=1,nres-1 +#ifdef PROCOR + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then +#else + if (itype(i).eq.ntyp1) 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 + write (iout,*) "ITEL" + do i=1,nres-1 + write (iout,*) i,itype(i),itel(i) + enddo + call read_bridge + + if (with_dihed_constr) then + + read (inp,*) 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) + 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 + do i=1,ndih_constr + phi0(i)=deg2rad*phi0(i) + drange(i)=deg2rad*drange(i) + enddo + endif + + endif + + 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 + 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) + 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 + endif + write (iout,'(a)') + return + end subroutine molread +!----------------------------------------------------------------------------- +! parmread.F +!----------------------------------------------------------------------------- + subroutine parmread(iparm,*) +#else + subroutine parmread +#endif +! +! Read the parameters of the probability distributions of the virtual-bond +! valence angles and the side chains and energy parameters. +! + use wham_data + + use geometry_data + use energy_data + use control_data, only: maxtor,maxterm,maxlor,maxterm_sccor,& + maxtermd_1,maxtermd_2,maxthetyp,maxthetyp1 + use MD_data +!el use MPI_data +!el use map_data + use io_config, only: printmat + use control, only: getenv_loc + +#ifdef MPI + use MPI_data + include "mpif.h" + integer :: IERROR +#endif +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.FREE' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.GEO' +! include 'COMMON.LOCAL' +! include 'COMMON.TORSION' +! include 'COMMON.FFIELD' +! include 'COMMON.NAMES' +! include 'COMMON.SBRIDGE' +! include 'COMMON.WEIGHTS' +! include 'COMMON.ENEPS' +! include 'COMMON.SCCOR' +! include 'COMMON.SCROT' +! include 'COMMON.FREE' + character(len=1) :: t1,t2,t3 + character(len=1) :: onelett(4) = (/"G","A","P","D"/) + character(len=1) :: toronelet(-2:2) = (/"p","a","G","A","P"/) + logical :: lprint + real(kind=8),dimension(3,3,maxlob) :: blower !(3,3,maxlob) + character(len=800) :: controlcard + character(len=256) :: bondname_t,thetname_t,rotname_t,torname_t,& + tordname_t,fouriername_t,elename_t,sidename_t,scpname_t,& + sccorname_t +!el integer ilen +!el external ilen + character(len=16) :: key + integer :: iparm +!el real(kind=8) :: ip,mp + real(kind=8) :: dwa16,akl,si,rri,epsij,rrij,sigeps,sigt1sq,& + sigt2sq,sigii1,sigii2,ratsig1,ratsig2,rsum_max,r_augm + real(kind=8) :: v0ij,v0ijsccor,v0ijsccor1,v0ijsccor2,v0ijsccor3,rjunk,& + res1 + integer :: i,j,ichir1,ichir2,k,l,m,kk,ii,mm,junk,lll,ll,llll,n + integer :: nlobi,iblock,maxinter,iscprol +! +! Body +! +! Set LPRINT=.TRUE. for debugging + dwa16=2.0d0**(1.0d0/6.0d0) + lprint=.false. + itypro=20 +! Assign virtual-bond length + vbl=3.8D0 + vblinv=1.0D0/vbl + vblinv2=vblinv*vblinv +#ifndef CLUSTER + call card_concat(controlcard,.true.) + wname(4)="WCORRH" +!el +allocate(ww(max_eneW)) + do i=1,n_eneW + key = wname(i)(:ilen(wname(i))) + call reada(controlcard,key(:ilen(key)),ww(i),1.0d0) + enddo + + write (iout,*) "iparm",iparm," myparm",myparm +! If reading not own parameters, skip assignment + + if (iparm.eq.myparm .or. .not.separate_parset) then + +! +! Setup weights for UNRES +! + wsc=ww(1) + wscp=ww(2) + welec=ww(3) + wcorr=ww(4) + wcorr5=ww(5) + wcorr6=ww(6) + wel_loc=ww(7) + wturn3=ww(8) + wturn4=ww(9) + wturn6=ww(10) + wang=ww(11) + wscloc=ww(12) + wtor=ww(13) + wtor_d=ww(14) + wvdwpp=ww(16) + wbond=ww(18) + wsccor=ww(19) + + endif +! +!el------ + allocate(weights(n_ene)) + 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)=0 !wstrain ! + weights(16)=0 !wvdwpp ! + weights(17)=wbond + weights(18)=0 !scal14 ! + weights(21)=wsccor +! el-------- + call card_concat(controlcard,.false.) + +! Return if not own parameters + + if (iparm.ne.myparm .and. separate_parset) return + + call reads(controlcard,"BONDPAR",bondname_t,bondname) + open (ibond,file=bondname_t,status='old') + rewind(ibond) + call reads(controlcard,"THETPAR",thetname_t,thetname) + open (ithep,file=thetname_t,status='old') + rewind(ithep) + call reads(controlcard,"ROTPAR",rotname_t,rotname) + open (irotam,file=rotname_t,status='old') + rewind(irotam) + call reads(controlcard,"TORPAR",torname_t,torname) + open (itorp,file=torname_t,status='old') + rewind(itorp) + call reads(controlcard,"TORDPAR",tordname_t,tordname) + open (itordp,file=tordname_t,status='old') + rewind(itordp) + call reads(controlcard,"SCCORPAR",sccorname_t,sccorname) + open (isccor,file=sccorname_t,status='old') + rewind(isccor) + call reads(controlcard,"FOURIER",fouriername_t,fouriername) + open (ifourier,file=fouriername_t,status='old') + rewind(ifourier) + call reads(controlcard,"ELEPAR",elename_t,elename) + open (ielep,file=elename_t,status='old') + rewind(ielep) + call reads(controlcard,"SIDEPAR",sidename_t,sidename) + open (isidep,file=sidename_t,status='old') + rewind(isidep) + call reads(controlcard,"SCPPAR",scpname_t,scpname) + open (iscpp,file=scpname_t,status='old') + rewind(iscpp) + write (iout,*) "Parameter set:",iparm + write (iout,*) "Energy-term weights:" + do i=1,n_eneW + write (iout,'(a16,f10.5)') wname(i),ww(i) + enddo + write (iout,*) "Sidechain potential file : ",& + sidename_t(:ilen(sidename_t)) +#ifndef OLDSCP + write (iout,*) "SCp potential file : ",& + scpname_t(:ilen(scpname_t)) +#endif + write (iout,*) "Electrostatic potential file : ",& + elename_t(:ilen(elename_t)) + write (iout,*) "Cumulant coefficient file : ",& + fouriername_t(:ilen(fouriername_t)) + write (iout,*) "Torsional parameter file : ",& + torname_t(:ilen(torname_t)) + write (iout,*) "Double torsional parameter file : ",& + tordname_t(:ilen(tordname_t)) + write (iout,*) "Backbone-rotamer parameter file : ",& + sccorname(:ilen(sccorname)) + write (iout,*) "Bond & inertia constant file : ",& + bondname_t(:ilen(bondname_t)) + write (iout,*) "Bending parameter file : ",& + thetname_t(:ilen(thetname_t)) + write (iout,*) "Rotamer parameter file : ",& + rotname_t(:ilen(rotname_t)) +#endif +! +! Read the virtual-bond parameters, masses, and moments of inertia +! and Stokes' radii of the peptide group and side chains +! + allocate(dsc(ntyp1)) !(ntyp1) + allocate(dsc_inv(ntyp1)) !(ntyp1) + allocate(nbondterm(ntyp)) !(ntyp) + allocate(vbldsc0(maxbondterm,ntyp)) !(maxbondterm,ntyp) + allocate(aksc(maxbondterm,ntyp)) !(maxbondterm,ntyp) +!el allocate(msc(ntyp+1)) !(ntyp+1) +!el allocate(isc(ntyp+1)) !(ntyp+1) +!el allocate(restok(ntyp+1)) !(ntyp+1) + allocate(abond0(maxbondterm,ntyp)) !(maxbondterm,ntyp) + +#ifdef CRYST_BOND + read (ibond,*) vbldp0,akp + do i=1,ntyp + nbondterm(i)=1 + read (ibond,*) vbldsc0(1,i),aksc(1,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,*) ijunk,vbldp0,akp,rjunk + do i=1,ntyp + read (ibond,*) 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 + else + dsc_inv(i)=1.0D0/dsc(i) + endif + enddo +#endif + if (lprint) then + write(iout,'(/a/)')"Force constants virtual bonds:" + write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K',& + 'inertia','Pstok' + write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0 + do i=1,ntyp + write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i),& + vbldsc0(1,i),aksc(1,i),abond0(1,i) + do j=2,nbondterm(i) + write (iout,'(13x,3f10.5)') & + vbldsc0(j,i),aksc(j,i),abond0(j,i) + enddo + enddo + endif +!---------------------------------------------------- + allocate(a0thet(-ntyp:ntyp),theta0(-ntyp:ntyp)) + allocate(sig0(-ntyp:ntyp),sigc0(-ntyp:ntyp)) !(-ntyp:ntyp) + allocate(athet(2,-ntyp:ntyp,-1:1,-1:1)) + allocate(bthet(2,-ntyp:ntyp,-1:1,-1:1)) !(2,-ntyp:ntyp,-1:1,-1:1) + allocate(polthet(0:3,-ntyp:ntyp)) !(0:3,-ntyp:ntyp) + allocate(gthet(3,-ntyp:ntyp)) !(3,-ntyp:ntyp) + do i=-ntyp,ntyp + 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 + enddo +!elwrite(iout,*) "parmread kontrol" + +#ifdef CRYST_THETA +! +! Read the parameters of the probability distribution/energy expression +! of the virtual-bond valence angles theta +! + do i=1,ntyp + read (ithep,*) a0thet(i),(athet(j,i,1,1),j=1,2),& + (bthet(j,i,1,1),j=1,2) + read (ithep,*) (polthet(j,i),j=0,3) +!elwrite(iout,*) "parmread kontrol in cryst_theta" + read (ithep,*) (gthet(j,i),j=1,3) +!elwrite(iout,*) "parmread kontrol in cryst_theta" + read (ithep,*) theta0(i),sig0(i),sigc0(i) + sigc0(i)=sigc0(i)**2 +!elwrite(iout,*) "parmread kontrol in cryst_theta" + enddo +!elwrite(iout,*) "parmread kontrol in cryst_theta" + 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 +!elwrite(iout,*) "parmread kontrol in cryst_theta" + 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 +!elwrite(iout,*) "parmread kontrol in cryst_theta" + close (ithep) +!elwrite(iout,*) "parmread kontrol in cryst_theta" + if (lprint) 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 + 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 +#else +! +! Read the parameters of Utheta determined from ab initio surfaces +! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 +! +! write (iout,*) "tu dochodze" + read (ithep,*) nthetyp,ntheterm,ntheterm2,& + ntheterm3,nsingle,ndouble + nntheterm=max0(ntheterm,ntheterm2,ntheterm3) + +!---------------------------------------------------- + allocate(ithetyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1) + allocate(aa0thet(-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) +!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + allocate(aathet(ntheterm,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) +!(maxtheterm,-maxthetyp1:maxthetyp1,& +! -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + allocate(bbthet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) + allocate(ccthet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) + allocate(ddthet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) + allocate(eethet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) +!(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,& +! -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + allocate(ffthet(ndouble,ndouble,ntheterm3,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) + allocate(ggthet(ndouble,ndouble,ntheterm3,-maxthetyp1:maxthetyp1,& + -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) +!(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,& +! -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)) + + + read (ithep,*) (ithetyp(i),i=1,ntyp1) + do i=-ntyp1,-1 + ithetyp(i)=-ithetyp(-i) + enddo +! write (iout,*) "tu dochodze" + 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 + do iblock=1,2 + do i=0,nthetyp + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + read (ithep,'(6a)') res1 + read (ithep,*) aa0thet(i,j,k,iblock) + read (ithep,*)(aathet(l,i,j,k,iblock),l=1,ntheterm) + read (ithep,*) & + ((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,*) & + (((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 +! +! For dummy ends assign glycine-type coefficients of theta-only terms; the +! coefficients of theta-and-gamma-dependent terms are zero. +! + 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 +! 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 + +! +! Control printout of the coefficients of virtual-bond-angle potentials +! +do iblock=1,2 + 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,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 + call flush(iout) + endif +enddo +#endif +!------------------------------------------- + allocate(nlob(ntyp1)) !(ntyp1) + allocate(bsc(maxlob,ntyp)) !(maxlob,ntyp) + allocate(censc(3,maxlob,-ntyp:ntyp)) !(3,maxlob,-ntyp:ntyp) + allocate(gaussc(3,3,maxlob,-ntyp:ntyp)) !(3,3,maxlob,-ntyp:ntyp) + + do i=1,ntyp + do j=1,maxlob + bsc(j,i)=0.0D0 + nlob(i)=0 + enddo + enddo + nlob(ntyp1)=0 + dsc(ntyp1)=0.0D0 + + do i=-ntyp,ntyp + do j=1,maxlob + 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 + enddo + enddo + +#ifdef CRYST_SC +! +! Read the parameters of the probability distribution/energy expression +! of the side chains. +! + do i=1,ntyp +!c 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 + 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,*)(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),& + ((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) +! 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 + write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i),& + ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) +! 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,'(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) +! write (iout,'(a)') +! do j=1,nlobi +! ind=0 +! do k=1,3 +! do l=1,k +! ind=ind+1 +! blower(k,l,j)=gaussc(ind,j,i) +! enddo +! enddo +! enddo + 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 + endif + enddo + endif +#else +! +! Read scrot parameters for potentials determined from all-atom AM1 calculations +! added by Urszula Kozlowska 07/11/2007 +! + allocate(sc_parmin(65,ntyp)) !(maxsccoef,ntyp) + + do i=1,ntyp + read (irotam,*) + if (i.eq.10) then + read (irotam,*) + else + do j=1,65 + read(irotam,*) sc_parmin(j,i) + enddo + endif + enddo +#endif + close(irotam) +#ifdef CRYST_TOR +! +! Read torsional parameters in old format +! + allocate(itortyp(ntyp1)) !(-ntyp1:ntyp1) + + read (itorp,*) ntortyp,nterm_old + write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old + read (itorp,*) (itortyp(i),i=1,ntyp) + +!el from energy module-------- + allocate(v1(nterm_old,ntortyp,ntortyp)) + allocate(v2(nterm_old,ntortyp,ntortyp)) !(maxterm,-maxtor:maxtor,-maxtor:maxtor) +!el--------------------------- + + do i=1,ntortyp + do j=1,ntortyp + read (itorp,'(a)') + do k=1,nterm_old + read (itorp,*) 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 +! +! Read torsional parameters +! + allocate(itortyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1) + + read (itorp,*) ntortyp + read (itorp,*) (itortyp(i),i=1,ntyp) + write (iout,*) 'ntortyp',ntortyp + +!el from energy module--------- + allocate(nterm(-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(-maxtor:maxtor,-maxtor:maxtor,2) + allocate(nlor(-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(-maxtor:maxtor,-maxtor:maxtor,2) + + allocate(vlor1(maxlor,-ntortyp:ntortyp,-ntortyp:ntortyp)) !(maxlor,-maxtor:maxtor,-maxtor:maxtor) + allocate(vlor2(maxlor,ntortyp,ntortyp)) + allocate(vlor3(maxlor,ntortyp,ntortyp)) !(maxlor,maxtor,maxtor) + allocate(v0(-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(-maxtor:maxtor,-maxtor:maxtor,2) + + allocate(v1(maxterm,-ntortyp:ntortyp,-ntortyp:ntortyp,2)) + allocate(v2(maxterm,-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) +!el--------------------------- + do iblock=1,2 + do i=-ntortyp,ntortyp + do j=-ntortyp,ntortyp + nterm(i,j,iblock)=0 + nlor(i,j,iblock)=0 + enddo + enddo + enddo +!el--------------------------- + + 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,*) 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,*) 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,iblock) + read (itorp,*) 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 + do iblock=1,2 !el + 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 + enddo + endif +! +! 6/23/01 Read parameters for double torsionals +! +!el from energy module------------ + allocate(v1c(2,maxtermd_1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2)) + allocate(v1s(2,maxtermd_1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2)) +!(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) + allocate(v2c(maxtermd_2,maxtermd_2,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2)) + allocate(v2s(maxtermd_2,maxtermd_2,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2)) + !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) + allocate(ntermd_1(-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2)) + allocate(ntermd_2(-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2)) + !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) +!--------------------------------- + + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + read (itordp,'(3a1)') t1,t2,t3 +! write (iout,*) "OK onelett", +! & 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,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,*) (v1c(1,l,i,j,k,iblock),l=1,& + ntermd_1(i,j,k,iblock)) + read (itordp,*) (v1s(1,l,i,j,k,iblock),l=1,& + ntermd_1(i,j,k,iblock)) + read (itordp,*) (v1c(2,l,i,j,k,iblock),l=1,& + ntermd_1(i,j,k,iblock)) + read (itordp,*) (v1s(2,l,i,j,k,iblock),l=1,& + ntermd_1(i,j,k,iblock)) +! 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) +! write(iout,*) "whcodze" , +! & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock) + enddo + read (itordp,*) ((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)) +! 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 +#endif +!elwrite(iout,*) "parmread kontrol sc-bb" +! Read of Side-chain backbone correlation parameters +! Modified 11 May 2012 by Adasko +!CC +! + read (isccor,*) nsccortyp + + maxinter=3 +!c maxinter is maximum interaction sites +!write(iout,*)"maxterm_sccor",maxterm_sccor +!el from module energy------------- + allocate(nlor_sccor(nsccortyp,nsccortyp)) !(-ntyp:ntyp,-ntyp:ntyp) + allocate(vlor1sccor(maxterm_sccor,nsccortyp,nsccortyp)) + allocate(vlor2sccor(maxterm_sccor,nsccortyp,nsccortyp)) + allocate(vlor3sccor(maxterm_sccor,nsccortyp,nsccortyp)) !(maxterm_sccor,20,20) +!----------------------------------- + allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp) +!----------------------------------- + allocate(nterm_sccor(-nsccortyp:nsccortyp,-nsccortyp:nsccortyp)) !(-ntyp:ntyp,-ntyp:ntyp) + allocate(v1sccor(maxterm_sccor,maxinter,-nsccortyp:nsccortyp,& + -nsccortyp:nsccortyp)) + allocate(v2sccor(maxterm_sccor,maxinter,-nsccortyp:nsccortyp,& + -nsccortyp:nsccortyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp) + allocate(v0sccor(maxinter,-nsccortyp:nsccortyp,& + -nsccortyp:nsccortyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp) +!----------------------------------- + do i=-nsccortyp,nsccortyp + do j=-nsccortyp,nsccortyp + nterm_sccor(j,i)=0 + enddo + enddo +!----------------------------------- + + read (isccor,*) (isccortyp(i),i=1,ntyp) + do i=-ntyp,-1 + isccortyp(i)=-isccortyp(-i) + enddo + iscprol=isccortyp(20) +! write (iout,*) 'ntortyp',ntortyp +! maxinter=3 +!c maxinter is maximum interaction sites + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + read (isccor,*) & + 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,*) 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,*) 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) + if (lprint) then + write (iout,'(/a/)') 'Torsional constants of SCCORR:' + 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),l=1,maxinter) + 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 +! +! 9/18/99 (AL) Read coefficients of the Fourier expansion of the local +! interaction energy of the Gly, Ala, and Pro prototypes. +! + read (ifourier,*) nloctyp +!el write(iout,*)"nloctyp",nloctyp +!el from module energy------- + allocate(b1(2,-nloctyp-1:nloctyp+1)) !(2,-maxtor:maxtor) + allocate(b2(2,-nloctyp-1:nloctyp+1)) !(2,-maxtor:maxtor) + allocate(b1tilde(2,-nloctyp-1:nloctyp+1)) !(2,-maxtor:maxtor) + allocate(cc(2,2,-nloctyp-1:nloctyp+1)) + allocate(dd(2,2,-nloctyp-1:nloctyp+1)) + allocate(ee(2,2,-nloctyp-1:nloctyp+1)) + allocate(ctilde(2,2,-nloctyp-1:nloctyp+1)) + allocate(dtilde(2,2,-nloctyp-1:nloctyp+1)) !(2,2,-maxtor:maxtor) + do i=1,2 + do ii=-nloctyp-1,nloctyp+1 + b1(i,ii)=0.0d0 + b2(i,ii)=0.0d0 + b1tilde(i,ii)=0.0d0 + do j=1,2 + cc(j,i,ii)=0.0d0 + dd(j,i,ii)=0.0d0 + ee(j,i,ii)=0.0d0 + ctilde(j,i,ii)=0.0d0 + dtilde(j,i,ii)=0.0d0 + enddo + enddo + enddo +!-------------------------------- + allocate(b(13,0:nloctyp)) + + do i=0,nloctyp-1 + 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) + B1(1,-i) = b(3,i) + B1(2,-i) = -b(5,i) +! b1(1,i)=0.0d0 +! b1(2,i)=0.0d0 + B1tilde(1,i) = b(3,i) + B1tilde(2,i) =-b(5,i) + B1tilde(1,-i) =-b(3,i) + B1tilde(2,-i) =b(5,i) +! b1tilde(1,i)=0.0d0 +! b1tilde(2,i)=0.0d0 + B2(1,i) = b(2,i) + B2(2,i) = b(4,i) + B2(1,-i) =b(2,i) + B2(2,-i) =-b(4,i) + +! b2(1,i)=0.0d0 +! b2(2,i)=0.0d0 + 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) + 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) +! CC(1,1,i)=0.0d0 +! CC(2,2,i)=0.0d0 +! CC(2,1,i)=0.0d0 +! CC(1,2,i)=0.0d0 + 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) + 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) + +! Ctilde(1,1,i)=0.0d0 +! Ctilde(1,2,i)=0.0d0 +! Ctilde(2,1,i)=0.0d0 +! Ctilde(2,2,i)=0.0d0 + 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) + 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) +! DD(1,1,i)=0.0d0 +! DD(2,2,i)=0.0d0 +! DD(2,1,i)=0.0d0 +! DD(1,2,i)=0.0d0 + 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) + 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) + +! Dtilde(1,1,i)=0.0d0 +! Dtilde(1,2,i)=0.0d0 +! Dtilde(2,1,i)=0.0d0 +! Dtilde(2,2,i)=0.0d0 + 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) + 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) + +! ee(1,1,i)=1.0d0 +! ee(2,2,i)=1.0d0 +! ee(2,1,i)=0.0d0 +! ee(1,2,i)=0.0d0 +! 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,'(f10.5)') B1(:,i) + write(iout,*) B1(1,i),B1(2,i) + write (iout,*) 'B2' +! 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) + 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 +! +! Read electrostatic-interaction parameters +! + if (lprint) then + 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,*) ((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) + 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 +! +! Read side-chain interaction parameters. +! +!el from module energy - COMMON.INTERACT------- + allocate(eps(ntyp,ntyp),sigmaii(ntyp,ntyp),rs0(ntyp,ntyp)) !(ntyp,ntyp) + allocate(augm(ntyp,ntyp)) !(ntyp,ntyp) + allocate(eps_scp(ntyp,2),rscp(ntyp,2)) !(ntyp,2) + allocate(sigma0(ntyp),rr0(ntyp),sigii(ntyp)) !(ntyp) + allocate(chip(ntyp1),alp(ntyp1)) !(ntyp) + do i=1,ntyp + do j=1,ntyp + augm(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 + enddo +!-------------------------------- + + read (isidep,*) ipot,expon +!el if (ipot.lt.1 .or. ipot.gt.5) then +! write (iout,'(2a)') 'Error while reading SC interaction',& +! 'potential file - unknown potential type.' +! stop +!wl endif + expon2=expon/2 + write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot),& + ', exponents are ',expon,2*expon +! goto (10,20,30,30,40) ipot + select case(ipot) +!----------------------- LJ potential --------------------------------- + case (1) +! 10 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),(sigma0(i),i=1,ntyp) + read (isidep,*)((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 +!----------------------- LJK potential -------------------------------- + case (2) +! 20 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),& + read (isidep,*)((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 +!---------------------- GB or BP potential ----------------------------- + case (3:4) +! 30 do i=1,ntyp + do i=1,ntyp + read (isidep,*)(eps(i,j),j=i,ntyp) + enddo + read (isidep,*)(sigma0(i),i=1,ntyp) + read (isidep,*)(sigii(i),i=1,ntyp) + read (isidep,*)(chip(i),i=1,ntyp) + read (isidep,*)(alp(i),i=1,ntyp) +! 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 +!--------------------- GBV potential ----------------------------------- + case (5) +! 40 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),& + 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) + 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 + case default + write (iout,'(2a)') 'Error while reading SC interaction',& + 'potential file - unknown potential type.' + stop +! 50 continue + end select +! continue + close (isidep) +!----------------------------------------------------------------------- +! Calculate the "working" parameters of SC interactions. + +!el from module energy - COMMON.INTERACT------- + allocate(aa(ntyp1,ntyp1),bb(ntyp1,ntyp1),chi(ntyp1,ntyp1)) !(ntyp,ntyp) + allocate(sigma(0:ntyp1,0:ntyp1),r0(ntyp1,ntyp1)) !(0:ntyp1,0:ntyp1) + do i=1,ntyp1 + do j=1,ntyp1 + aa(i,j)=0.0D0 + bb(i,j)=0.0D0 + chi(i,j)=0.0D0 + sigma(i,j)=0.0D0 + r0(i,j)=0.0D0 + enddo + enddo +!-------------------------------- + + 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 +! if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then + sigmaii(i,j)=rsum_max + sigmaii(j,i)=rsum_max +! else +! sigmaii(i,j)=r0(i,j) +! sigmaii(j,i)=r0(i,j) +! endif +!d 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) +! 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 + + allocate(aad(ntyp,2),bad(ntyp,2)) !(ntyp,2) + do i=1,ntyp + do j=1,2 + bad(i,j)=0.0D0 + enddo + enddo +#ifdef CLUSTER +! +! Define the SC-p interaction constants +! + do i=1,20 + do j=1,2 + eps_scp(i,j)=-1.5d0 + rscp(i,j)=4.0d0 + enddo + enddo +#endif + +!elwrite(iout,*) "parmread kontrol before oldscp" +! +! Define the SC-p interaction constants +! +#ifdef OLDSCP + do i=1,20 +! "Soft" SC-p repulsion (causes helices to be too flat, but facilitates +! helix formation) +! aad(i,1)=0.3D0*4.0D0**12 +! Following line for constants currently implemented +! "Hard" SC-p repulsion (gives correct turn spacing in helices) + aad(i,1)=1.5D0*4.0D0**12 +! aad(i,1)=0.17D0*5.6D0**12 + aad(i,2)=aad(i,1) +! "Soft" SC-p repulsion + bad(i,1)=0.0D0 +! Following line for constants currently implemented +! aad(i,1)=0.3D0*4.0D0**6 +! "Hard" SC-p repulsion + bad(i,1)=3.0D0*4.0D0**6 +! bad(i,1)=-2.0D0*0.17D0*5.6D0**6 + bad(i,2)=bad(i,1) +! aad(i,1)=0.0D0 +! aad(i,2)=0.0D0 +! bad(i,1)=1228.8D0 +! bad(i,2)=1228.8D0 + enddo +#else +! +! 8/9/01 Read the SC-p interaction constants from file +! + do i=1,ntyp + read (iscpp,*) (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 +! +! Define the constants of the disulfide bridge +! + ebr=-5.50D0 +! +! Old arbitrary potential - commented out. +! +! dbr= 4.20D0 +! fbr= 3.30D0 +! +! Constants of the disulfide-bond potential determined based on the RHF/6-31G** +! energy surface of diethyl disulfide. +! A. Liwo and U. Kozlowska, 11/24/03 +! + D0CM = 3.78d0 + AKCM = 15.1d0 + AKTH = 11.0d0 + AKCT = 12.0d0 + V1SS =-1.08d0 + V2SS = 7.61d0 + 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 + return + end subroutine parmread +#ifndef CLUSTER +!----------------------------------------------------------------------------- +! mygetenv.F +!----------------------------------------------------------------------------- + subroutine mygetenv(string,var) +! +! Version 1.0 +! +! This subroutine passes the environmental variables to FORTRAN program. +! If the flags -DMYGETENV and -DMPI are not for compilation, it calls the +! standard FORTRAN GETENV subroutine. If both flags are set, the subroutine +! reads the environmental variables from $HOME/.env +! +! Usage: As for the standard FORTRAN GETENV subroutine. +! +! Purpose: some versions/installations of MPI do not transfer the environmental +! variables to slave processors, if these variables are set in the shell script +! from which mpirun is called. +! +! A.Liwo, 7/29/01 +! +#ifdef MPI + use MPI_data + include "mpif.h" +#endif +! implicit none + character*(*) :: string,var +#if defined(MYGETENV) && defined(MPI) +! include "DIMENSIONS.ZSCOPT" +! include "mpif.h" +! include "COMMON.MPI" +!el character*360 ucase +!el external ucase + character(len=360) :: string1(360),karta + character(len=240) :: home + integer i,n !,ilen +!el external ilen + call getenv("HOME",home) + open(99,file=home(:ilen(home))//"/.env",status="OLD",err=112) + do while (.true.) + read (99,end=111,err=111,'(a)') karta + do i=1,80 + string1(i)=" " + enddo + call split_string(karta,string1,80,n) + if (ucase(string1(1)(:ilen(string1(1)))).eq."SETENV" .and. & + string1(2)(:ilen(string1(2))).eq.string(:ilen(string)) ) then + var=string1(3) + print *,"Processor",me,": ",var(:ilen(var)),& + " assigned to ",string(:ilen(string)) + close(99) + return + endif + enddo + 111 print *,"Environment variable ",string(:ilen(string))," not set." + close(99) + return + 112 print *,"Error opening environment file!" +#else + call getenv(string,var) +#endif + return + end subroutine mygetenv +!----------------------------------------------------------------------------- +! readrtns.F +!----------------------------------------------------------------------------- + subroutine read_general_data(*) + + use control_data, only:indpdb,symetr + use energy_data, only:distchainmax +! 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(len=800) :: controlcard + integer :: i,j,k,ii,n_ene_found + integer :: ind,itype1,itype2,itypf,itypsc,itypp +!el integer ilen +!el external ilen +!el character*16 ucase + character(len=16) :: key +!el external ucase + call card_concat(controlcard,.true.) + call readi(controlcard,"N_ENE",n_eneW,max_eneW) + if (n_eneW.gt.max_eneW) then + write (iout,*) "Error: parameter out of range: N_ENE",n_eneW,& + max_eneW + return 1 + endif + call readi(controlcard,"NPARMSET",nparmset,1) +write(iout,*)"in read_gen data" + 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 + return 1 + endif +write(iout,*)"in read_gen data" + 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 + allocate(isampl(nparmset)) + call multreadi(controlcard,"ISAMPL",isampl,nparmset,1) + write (iout,*) "MaxSlice",MaxSlice + call readi(controlcard,"NSLICE",nslice,1) +write(iout,*)"in read_gen data" + call flush(iout) + if (nslice.gt.MaxSlice) then + write (iout,*) "Error: parameter out of range: NSLICE",nslice,& + MaxSlice + return 1 + 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 + return 1 + 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 reada(controlcard,"DELTRGY",deltrgy,5.0d-2) + call readi(controlcard,"RESCALE",rescale_modeW,1) + check_conf=index(controlcard,"NO_CHECK_CONF").eq.0 + call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0) + call readi(controlcard,'SYM',symetr,1) + write (iout,*) "DISTCHAINMAX",distchainmax + write (iout,*) "delta",delta + write (iout,*) "einicheck",einicheck + write (iout,*) "rescale_mode",rescale_modeW + 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 + write (iout,*) "with_dihed_constr ",with_dihed_constr + call readi(controlcard,'CONSTR_DIST',constr_dist,0) + return + end subroutine read_general_data +!------------------------------------------------------------------------------ + subroutine read_efree(*) +! +! Read molecular data +! +! 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(len=320) :: controlcard !,ucase + integer :: iparm,ib,i,j,npars +!el integer ilen +!el external ilen + + if (hamil_rep) then + npars=1 + else + npars=nParmSet + endif + +! call alloc_wham_arrays +! allocate(nT_h(nParmSet)) +! allocate(replica(nParmSet)) +! allocate(umbrella(nParmSet)) +! allocate(read_iset(nParmSet)) +! allocate(nT_h(nParmSet)) + + 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 + return 1 + 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 + return 1 + 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 subroutine read_efree +!----------------------------------------------------------------------------- + subroutine read_protein_data(*) +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +#ifdef MPI + use MPI_data + 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(len=64) :: nazwa + character(len=16000) :: controlcard + integer :: i,ii,ib,iR,iparm,nthr,npars !,ilen,iroof +!el external ilen,iroof + if (hamil_rep) then + npars=1 + else + npars=nparmset + endif + + do iparm=1,npars + +! 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!" + return 1 + 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 subroutine read_protein_data +!------------------------------------------------------------------------------- + subroutine readsss(rekord,lancuch,wartosc,default) +! implicit none + character*(*) :: rekord,lancuch,wartosc,default + character(len=80) :: aux + integer :: lenlan,lenrec,iread,ireade +!el external ilen +!el logical iblnk +!el external iblnk + lenlan=ilen(lancuch) + lenrec=ilen(rekord) + iread=index(rekord,lancuch(:lenlan)//"=") +! print *,"rekord",rekord," lancuch",lancuch +! print *,"iread",iread," lenlan",lenlan," lenrec",lenrec + if (iread.eq.0) then + wartosc=default + return + endif + iread=iread+lenlan+1 +! print *,"iread",iread +! print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) + do while (iread.le.lenrec .and. iblnk(rekord(iread:iread))) + iread=iread+1 +! print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) + enddo +! print *,"iread",iread + if (iread.gt.lenrec) then + wartosc=default + return + endif + ireade=iread+1 +! print *,"ireade",ireade + do while (ireade.lt.lenrec .and. & + .not.iblnk(rekord(ireade:ireade))) + ireade=ireade+1 + enddo + wartosc=rekord(iread:ireade) + return + end subroutine readsss +!---------------------------------------------------------------------------- + subroutine multreads(rekord,lancuch,tablica,dim,default) +! implicit none + integer :: dim,i + character*(*) rekord,lancuch,tablica(dim),default + character(len=80) :: aux + integer :: lenlan,lenrec,iread,ireade +!el external ilen +!el logical iblnk +!el external iblnk + do i=1,dim + tablica(i)=default + enddo + lenlan=ilen(lancuch) + lenrec=ilen(rekord) + iread=index(rekord,lancuch(:lenlan)//"=") +! print *,"rekord",rekord," lancuch",lancuch +! print *,"iread",iread," lenlan",lenlan," lenrec",lenrec + if (iread.eq.0) return + iread=iread+lenlan+1 + do i=1,dim +! print *,"iread",iread +! print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) + do while (iread.le.lenrec .and. iblnk(rekord(iread:iread))) + iread=iread+1 +! print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) + enddo +! print *,"iread",iread + if (iread.gt.lenrec) return + ireade=iread+1 +! 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 subroutine multreads +!---------------------------------------------------------------------------- + subroutine split_string(rekord,tablica,dim,nsub) +! implicit none + integer :: dim,nsub,i,ii,ll,kk + character*(*) tablica(dim) + character*(*) rekord +!el integer ilen +!el external ilen + do i=1,dim + tablica(i)=" " + enddo + ii=1 + ll = ilen(rekord) + nsub=0 + do i=1,dim +! Find the start of term name + kk = 0 + do while (ii.le.ll .and. rekord(ii:ii).eq." ") + ii = ii+1 + enddo +! 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 subroutine split_string +!-------------------------------------------------------------------------------- +! readrtns_compar.F +!-------------------------------------------------------------------------------- + subroutine read_compar +! +! Read molecular data +! + use conform_compar, only:alloc_compar_arrays + use control_data, only:pdbref + use geometry_data, only:deg2rad,rad2deg +! 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.COMPAR' +! include 'COMMON.CHAIN' +! include 'COMMON.HEADER' +! include 'COMMON.GEO' +! include 'COMMON.FREE' + character(len=320) :: controlcard !,ucase + character(len=64) :: wfile +!el integer ilen +!el external ilen + integer :: i,j,k +write(iout,*)"jestesmy w read_compar" + call card_concat(controlcard,.true.) + pdbref=(index(controlcard,'PDBREF').gt.0) + call reada(controlcard,'CUTOFF_UP',rmscut_base_up,4.0d0) + call reada(controlcard,'CUTOFF_LOW',rmscut_base_low,3.0d0) + call reada(controlcard,'RMSUP_LIM',rmsup_lim,4.0d0) + call reada(controlcard,'RMSUPUP_LIM',rmsupup_lim,7.5d0) + verbose = index(controlcard,"VERBOSE").gt.0 + lgrp=index(controlcard,"STATIN").gt.0 + lgrp_out=index(controlcard,"STATOUT").gt.0 + merge_helices=index(controlcard,"DONT_MERGE_HELICES").eq.0 + binary = index(controlcard,"BINARY").gt.0 + rmscut_base_up=rmscut_base_up/50 + rmscut_base_low=rmscut_base_low/50 + call reada(controlcard,"FRAC_SEC",frac_sec,0.66666666d0) + call readi(controlcard,'NLEVEL',nlevel,1) + if (nlevel.lt.0) then + allocate(nfrag(2)) + call alloc_compar_arrays(maxfrag,1) + goto 121 + else + allocate(nfrag(nlevel)) + endif +! Read the data pertaining to elementary fragments (level 1) + call readi(controlcard,'NFRAG',nfrag(1),0) + write(iout,*)"nfrag(1)",nfrag(1) + call alloc_compar_arrays(nfrag(1),nlevel) + do j=1,nfrag(1) + call card_concat(controlcard,.true.) + write (iout,*) controlcard(:ilen(controlcard)) + call readi(controlcard,'NPIECE',npiece(j,1),0) + call readi(controlcard,'N_SHIFT1',n_shift(1,j,1),0) + call readi(controlcard,'N_SHIFT2',n_shift(2,j,1),0) + call reada(controlcard,'ANGCUT',ang_cut(j),50.0d0) + call reada(controlcard,'MAXANG',ang_cut1(j),360.0d0) + call reada(controlcard,'FRAC_MIN',frac_min(j),0.666666d0) + call reada(controlcard,'NC_FRAC',nc_fragm(j,1),0.5d0) + call readi(controlcard,'NC_REQ',nc_req_setf(j,1),0) + call readi(controlcard,'RMS',irms(j,1),0) + call readi(controlcard,'LOCAL',iloc(j),1) + call readi(controlcard,'ELCONT',ielecont(j,1),1) + if (ielecont(j,1).eq.0) then + call readi(controlcard,'SCCONT',isccont(j,1),1) + endif + ang_cut(j)=ang_cut(j)*deg2rad + ang_cut1(j)=ang_cut1(j)*deg2rad + do k=1,npiece(j,1) + call card_concat(controlcard,.true.) + call readi(controlcard,'IFRAG1',ifrag(1,k,j),0) + call readi(controlcard,'IFRAG2',ifrag(2,k,j),0) + enddo + write(iout,*)"j",j," npiece",npiece(j,1)," ifrag",& + (ifrag(1,k,j),ifrag(2,k,j),& + k=1,npiece(j,1))," ang_cut",ang_cut(j)*rad2deg,& + " ang_cut1",ang_cut1(j)*rad2deg + write(iout,*)"n_shift",n_shift(1,j,1),n_shift(2,j,1) + write(iout,*)"nc_frac",nc_fragm(j,1)," nc_req",nc_req_setf(j,1) + write(iout,*)"irms",irms(j,1)," ielecont",ielecont(j,1),& + " ilocal",iloc(j)," isccont",isccont(j,1) + enddo +! Read data pertaning to higher levels + do i=2,nlevel + call card_concat(controlcard,.true.) + call readi(controlcard,'NFRAG',NFRAG(i),0) + write (iout,*) "i",i," nfrag",nfrag(i) + do j=1,nfrag(i) + call card_concat(controlcard,.true.) + if (i.eq.2) then + call readi(controlcard,'ELCONT',ielecont(j,i),0) + if (ielecont(j,i).eq.0) then + call readi(controlcard,'SCCONT',isccont(j,i),1) + endif + call readi(controlcard,'RMS',irms(j,i),0) + else + ielecont(j,i)=0 + isccont(j,i)=0 + irms(j,i)=1 + endif + call readi(controlcard,'NPIECE',npiece(j,i),0) + call readi(controlcard,'N_SHIFT1',n_shift(1,j,i),0) + call readi(controlcard,'N_SHIFT2',n_shift(2,j,i),0) + call multreadi(controlcard,'IPIECE',ipiece(1,j,i),& + npiece(j,i),0) + call reada(controlcard,'NC_FRAC',nc_fragm(j,i),0.5d0) + call readi(controlcard,'NC_REQ',nc_req_setf(j,i),0) + write(iout,*) "j",j," npiece",npiece(j,i)," n_shift",& + n_shift(1,j,i),n_shift(2,j,i)," ielecont",ielecont(j,i),& + " isccont",isccont(j,i)," irms",irms(j,i) + write(iout,*) "ipiece",(ipiece(k,j,i),k=1,npiece(j,i)) + write(iout,*)"n_shift",n_shift(1,j,i),n_shift(2,j,i) + write(iout,*)"nc_frac",nc_fragm(j,i),& + " nc_req",nc_req_setf(j,i) + enddo + enddo + if (binary) write (iout,*) "Classes written in binary format." + return + 121 continue + call reada(controlcard,'ANGCUT_HEL',angcut_hel,50.0d0) + call reada(controlcard,'MAXANG_HEL',angcut1_hel,60.0d0) + call reada(controlcard,'ANGCUT_BET',angcut_bet,90.0d0) + call reada(controlcard,'MAXANG_BET',angcut1_bet,360.0d0) + call reada(controlcard,'ANGCUT_STRAND',angcut_strand,90.0d0) + call reada(controlcard,'MAXANG_STRAND',angcut1_strand,60.0d0) + call reada(controlcard,'FRAC_MIN',frac_min_set,0.666666d0) + call reada(controlcard,'NC_FRAC_HEL',ncfrac_hel,0.5d0) + call readi(controlcard,'NC_REQ_HEL',ncreq_hel,0) + call reada(controlcard,'NC_FRAC_BET',ncfrac_bet,0.5d0) + call reada(controlcard,'NC_FRAC_PAIR',ncfrac_pair,0.3d0) + call readi(controlcard,'NC_REQ_BET',ncreq_bet,0) + call readi(controlcard,'NC_REQ_PAIR',ncreq_pair,0) + call readi(controlcard,'NSHIFT_HEL',nshift_hel,3) + call readi(controlcard,'NSHIFT_BET',nshift_bet,3) + call readi(controlcard,'NSHIFT_STRAND',nshift_strand,3) + call readi(controlcard,'NSHIFT_PAIR',nshift_pair,3) + call readi(controlcard,'RMS_SINGLE',irms_single,0) + call readi(controlcard,'CONT_SINGLE',icont_single,1) + call readi(controlcard,'LOCAL_SINGLE',iloc_single,1) + call readi(controlcard,'RMS_PAIR',irms_pair,0) + call readi(controlcard,'CONT_PAIR',icont_pair,1) + call readi(controlcard,'SPLIT_BET',isplit_bet,0) + angcut_hel=angcut_hel*deg2rad + angcut1_hel=angcut1_hel*deg2rad + angcut_bet=angcut_bet*deg2rad + angcut1_bet=angcut1_bet*deg2rad + angcut_strand=angcut_strand*deg2rad + angcut1_strand=angcut1_strand*deg2rad + write (iout,*) "Automatic detection of structural elements" + write (iout,*) 'NC_FRAC_HEL',ncfrac_hel,' NC_REQ_HEL',ncreq_hel,& + ' NC_FRAC_BET',ncfrac_bet,' NC_REQ_BET',ncreq_bet,& + ' RMS_SINGLE',irms_single,' CONT_SINGLE',icont_single,& + ' NC_FRAC_PAIR',ncfrac_pair,' NC_REQ_PAIR',ncreq_pair,& + ' RMS_PAIR',irms_pair,' CONT_PAIR',icont_pair,& + ' SPLIT_BET',isplit_bet + write (iout,*) 'NSHIFT_HEL',nshift_hel,' NSHIFT_BET',nshift_bet,& + ' NSHIFT_STRAND',nshift_strand,' NSHIFT_PAIR',nshift_pair + write (iout,*) 'ANGCUT_HEL',angcut_hel*rad2deg,& + ' MAXANG_HEL',angcut1_hel*rad2deg + write (iout,*) 'ANGCUT_BET',angcut_bet*rad2deg,& + ' MAXANG_BET',angcut1_bet*rad2deg + write (iout,*) 'ANGCUT_STRAND',angcut_strand*rad2deg,& + ' MAXANG_STRAND',angcut1_strand*rad2deg + write (iout,*) 'FRAC_MIN',frac_min_set + return + end subroutine read_compar +!-------------------------------------------------------------------------------- +! read_ref_str.F +!-------------------------------------------------------------------------------- + subroutine read_ref_structure(*) +! +! Read the reference structure from the PDB file or from a PDB file or in the form of the dihedral +! angles. +! + use control_data, only:pdbref + use geometry_data, only:nres,cref,c,dc,nsup,dc_norm,nend_sup,& + nstart_sup,nstart_seq,nperm,nres0 + use energy_data, only:nct,nnt,icont_ref,ncont_ref,itype + use compare, only:seq_comp !,contact,elecont + use geometry, only:chainbuild,dist + use io_config, only:readpdb +! + use conform_compar, only:contact,elecont +! implicit none +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'DIMENSIONS.COMPAR' +! 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.CONTACTS1' +! include 'COMMON.PEPTCONT' +! include 'COMMON.TIME1' +! include 'COMMON.COMPAR' + character(len=4) :: sequence(nres) +!el integer rescode +!el real(kind=8) :: x(maxvar) + integer :: itype_pdb(nres) +!el logical seq_comp + integer :: i,j,k,nres_pdb,iaux + real(kind=8) :: ddsc !el,dist + integer :: kkk !,ilen +!el external ilen +! + nres0=nres + write (iout,*) "pdbref",pdbref + if (pdbref) then + read(inp,'(a)') pdbfile + write (iout,'(2a,1h.)') '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.' + return 1 + 34 continue + do i=1,nres + itype_pdb(i)=itype(i) + enddo +write(iout,*)"jestesmy przed readpdb" + call readpdb + do i=1,nres + iaux=itype_pdb(i) + itype_pdb(i)=itype(i) + itype(i)=iaux + enddo + close (ipdbin) + do kkk=1,nperm + nres_pdb=nres + nres=nres0 + 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 + do j=nnt+nsup-1,nnt,-1 + do k=1,3 + cref(k,nres+j+i,kkk)=cref(k,nres_pdb+j,kkk) + enddo + enddo + do j=nnt+nsup-1,nnt,-1 + do k=1,3 + cref(k,j+i,kkk)=cref(k,j,kkk) + enddo + phi_ref(j+i)=phi_ref(j) + theta_ref(j+i)=theta_ref(j) + alph_ref(j+i)=alph_ref(j) + omeg_ref(j+i)=omeg_ref(j) + enddo +#ifdef DEBUG + do j=nnt,nct + write (iout,'(i5,3f10.5,5x,3f10.5)') & + j,(cref(k,j,kkk),k=1,3),(cref(k,j+nres,kkk),k=1,3) + enddo +#endif + nstart_seq=nnt+i + nstart_sup=nnt+i + goto 111 + endif + enddo + write (iout,'(a)') & + 'Error - sequences to be superposed do not match.' + return 1 + 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 + enddo + 111 continue + write (iout,'(a,i5)') & + 'Experimental structure begins at residue',nstart_seq + else + call read_angles(inp,*38) + goto 39 + 38 write (iout,'(a)') 'Error reading reference structure.' + return 1 + 39 call chainbuild + kkk=1 + nstart_sup=nnt + nstart_seq=nnt + nsup=nct-nnt+1 + do i=1,2*nres + do j=1,3 + cref(j,i,kkk)=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,kkk) + enddo + enddo + do i=1,nres + do j=1,3 + dc(j,nres+i)=cref(j,nres+i,kkk)-cref(j,i,kkk) + enddo + if (itype(i).ne.10) then + ddsc = dist(i,nres+i) + do j=1,3 + dc_norm(j,nres+i)=dc(j,nres+i)/ddsc + enddo + else + do j=1,3 + dc_norm(j,nres+i)=0.0d0 + enddo + endif +! write (iout,*) "i",i," dc_norm",(dc_norm(k,nres+i),k=1,3), +! " norm",dc_norm(1,nres+i)**2+dc_norm(2,nres+i)**2+ +! dc_norm(3,nres+i)**2 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + enddo + ddsc = dist(i,i+1) + do j=1,3 + dc_norm(j,i)=dc(j,i)/ddsc + enddo + enddo +! print *,"Calling contact" + call contact(.true.,ncont_ref,icont_ref(1,1),& + nstart_sup,nend_sup) +! print *,"Calling elecont" + call elecont(.true.,ncont_pept_ref,& + icont_pept_ref(1,1),& + nstart_sup,nend_sup) + write (iout,'(a,i3,a,i3,a,i3,a)') & + 'Number of residues to be superposed:',nsup,& + ' (from residue',nstart_sup,' to residue',& + nend_sup,').' + return + end subroutine read_ref_structure +!-------------------------------------------------------------------------------- +! geomout.F +!-------------------------------------------------------------------------------- + subroutine pdboutW(ii,temp,efree,etot,entropy,rmsdev) + + use geometry_data, only:nres,c + use energy_data, only:nss,nnt,nct,ihpb,jhpb,itype +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'DIMENSIONS.ZSCOPT' +! include 'COMMON.CHAIN' +! include 'COMMON.INTERACT' +! include 'COMMON.NAMES' +! include 'COMMON.IOUNITS' +! include 'COMMON.HEADER' +! include 'COMMON.SBRIDGE' + character(len=50) :: tytul + character(len=1),dimension(10) :: chainid=reshape((/'A','B','C',& + 'D','E','F','G','H','I','J'/),shape(chainid)) + integer,dimension(nres) :: ica !(maxres) + real(kind=8) :: temp,efree,etot,entropy,rmsdev + integer :: ii,i,j,iti,ires,iatom,ichain + write(ipdb,'("REMARK CONF",i8," TEMPERATURE",f7.1," RMS",0pf7.2)')& + ii,temp,rmsdev + write (ipdb,'("REMARK DIMENSIONLESS FREE ENERGY",1pe15.5)') & + efree + write (ipdb,'("REMARK ENERGY",1pe15.5," ENTROPY",1pe15.5)') & + etot,entropy + iatom=0 + ichain=1 + ires=0 + do i=nnt,nct + iti=itype(i) + if (iti.eq.ntyp1) then + ichain=ichain+1 + ires=0 + write (ipdb,'(a)') 'TER' + else + ires=ires+1 + iatom=iatom+1 + ica(i)=iatom + write (ipdb,10) iatom,restyp(iti),chainid(ichain),& + ires,(c(j,i),j=1,3) + if (iti.ne.10) then + iatom=iatom+1 + write (ipdb,20) iatom,restyp(iti),chainid(ichain),& + ires,(c(j,nres+i),j=1,3) + endif + endif + enddo + write (ipdb,'(a)') 'TER' + do i=nnt,nct-1 + 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.ntyp1) then + write (ipdb,30) ica(i),ica(i+1),ica(i)+1 + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then + write (ipdb,30) ica(i),ica(i)+1 + endif + enddo + if (itype(nct).ne.10) then + 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 + enddo + write (ipdb,'(a6)') 'ENDMDL' + 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) + 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3) + 30 FORMAT ('CONECT',8I5) + return + end subroutine pdboutW +#endif +!------------------------------------------------------------------------------ + end module io_wham +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + diff --git a/source/wham/proc_proc.c b/source/wham/proc_proc.c new file mode 100644 index 0000000..d9cece6 --- /dev/null +++ b/source/wham/proc_proc.c @@ -0,0 +1,140 @@ +#include +#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/wham/w_comm_local.f90 b/source/wham/w_comm_local.f90 new file mode 100644 index 0000000..0df9100 --- /dev/null +++ b/source/wham/w_comm_local.f90 @@ -0,0 +1,9 @@ + module w_comm_local +!------------------------------------------------------------------------------- +! common /ccc/ + real(kind=8),dimension(:,:),allocatable :: creff,cc !(3,nres*2) + logical,dimension(:),allocatable :: iadded !(nres) + integer,dimension(:,:),allocatable :: inumber !(2,nres) +!------------------------------------------------------------------------------- + end module w_comm_local + diff --git a/source/wham/w_compar_data.f90 b/source/wham/w_compar_data.f90 new file mode 100644 index 0000000..00b2d2a --- /dev/null +++ b/source/wham/w_compar_data.f90 @@ -0,0 +1,55 @@ + module w_compar_data +!--------------------------------------------------------------------------- +! use names +!--------------------------------------------------------------------------- +! commom.contacts (in energy_data) +! common /contacts/ + integer,dimension(:),allocatable :: nsccont_frag_ref !(mmaxfrag) !wham + integer,dimension(:,:,:),allocatable :: isccont_frag_ref !(2,maxcont,mmaxfrag) !wham +!----------------------------------------------------------------------------- +! COMMON.COMPAR +! common /compar/ + real(kind=8),dimension(:,:),allocatable :: rmsfrag,& + nc_fragm !(maxfrag,maxlevel) + real(kind=8),dimension(:,:),allocatable :: qfrag !(maxfrag,2) + real(kind=8) :: rmscut_base_low,rmscut_base_up,& + rmsup_lim,rmsupup_lim + real(kind=8),dimension(:,:,:),allocatable :: rmscutfrag !(2,maxfrag,maxlevel) + real(kind=8) :: rms_nat,qnat,rmsang + real(kind=8),dimension(:),allocatable :: ang_cut,ang_cut1,frac_min!(maxfrag) + integer,dimension(:,:),allocatable :: nc_req_setf,npiece,& + ielecont,isccont,irms,ishifft,len_frag !(maxfrag,maxlevel) + integer,dimension(:,:,:),allocatable :: ncont_nat,& + n_shift !(2,maxfrag,maxlevel) + integer,dimension(:),allocatable :: nfrag !(maxlevel) + integer,dimension(:),allocatable :: isnfrag !(maxlevel+1) + integer,dimension(:,:,:),allocatable :: ifrag !(2,maxpiece,maxfrag) + integer,dimension(:,:,:),allocatable :: ipiece !(maxpiece,maxfrag,2:maxlevel) + integer,dimension(:),allocatable ::istruct,iloc,nlist_frag !(maxfrag) + integer,dimension(:,:),allocatable :: iclass !(maxlevel*maxfrag,maxlevel) + integer :: iscore,nlevel,ibase + logical :: lgrp,lgrp_out,binary + integer,dimension(:,:),allocatable :: list_frag !(maxres,maxfrag) +! common /compar1/ + real(kind=8) :: angcut_hel,angcut1_hel,angcut_bet,angcut1_bet,& + angcut_strand,angcut1_strand,frac_min_set,ncfrac_hel,& + ncfrac_bet,ncfrac_pair,frac_sec + integer :: ncreq_hel,ncreq_bet,ncreq_pair,irms_pair,& + icont_pair,isplit_bet,nshift_hel,nshift_bet,nshift_strand,& + nshift_pair,irms_single,icont_single,iloc_single +!--------------------------------------------------------------------------- +! COMMON.VAR +! Angles from experimental structure +! common /varref/ + real(kind=8),dimension(:),allocatable :: vbld_ref,theta_ref,& + phi_ref,alph_ref,omeg_ref !(maxres) +!--------------------------------------------------------------------------- +! COMMON.CONTPAR +! common /contpar/ + real(kind=8),dimension(:,:),allocatable :: sig_comp,chi_comp,& + chip_comp,sc_cutoff !(ntyp,ntyp) +! real(kind=8),dimension(ntyp,ntyp) :: sig_comp,chi_comp,& +! chip_comp,sc_cutoff !(ntyp,ntyp) +!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- + end module w_compar_data diff --git a/source/wham/wham.f90 b/source/wham/wham.f90 new file mode 100644 index 0000000..fcf1d15 --- /dev/null +++ b/source/wham/wham.f90 @@ -0,0 +1,372 @@ + program wham_multparm +! program WHAM_multparm +! Creation/update of the database of conformations + use wham_data + use io_wham + use io_database + use wham_calc + use ene_calc + use conform_compar + use work_part +! + use io_units + use control_data, only:indpdb +#ifdef MPI + use mpi_data +! use mpi_ +#endif + use control, only:initialize +!el use io_config, only:parmread +! +#ifndef ISNAN + external proc_proc +#ifdef WINPGI +!MS$ATTRIBUTES C :: proc_proc +#endif +#endif +! +!el#ifndef ISNAN +!el external proc_proc +!el#endif +!el#ifdef WINPGI +!elcMS$ATTRIBUTES C :: proc_proc +!el#endif +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +! implicit none +#ifdef MPI +! include "COMMON.MPI" +! use mpi_data + include "mpif.h" + integer :: IERROR,ERRCODE +#endif +! include "COMMON.IOUNITS" +! include "COMMON.FREE" +! include "COMMON.CONTROL" +! include "COMMON.ALLPARM" +! include "COMMON.PROT" + real(kind=8) :: rr !,x(max_paropt) + integer :: idumm + integer :: i,ipar,islice + +!el run_wham=.true. +!#define WHAM_RUN +! call alloc_wham_arrays +!write(iout,*) "after alloc wham" +#ifdef MPI + call MPI_Init( IERROR ) + call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR ) + call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR ) + Master = 0 + if (ierror.gt.0) then + write(iout,*) "SEVERE ERROR - Can't initialize MPI." + call mpi_finalize(ierror) + stop + endif +!el if (nprocs.gt.MaxProcs+1) then +!el write (2,*) "Error - too many processors",& +!el nprocs,MaxProcs+1 +!el write (2,*) "Increase MaxProcs and recompile" +!el call MPI_Finalize(IERROR) +!el stop +!el endif +#endif +! NaNQ initialization +#ifndef ISNAN + i=-1 + rr=dacos(100.0d0) +#ifdef WINPGI + idumm=proc_proc(rr,i) +#else + call proc_proc(rr,i) +#endif +#endif +!write(iout,*) "before init" + call initialize +!write(iout,*)"after init" + call openunits +!write(iout,*)"after open ui" + call cinfo +!write(iout,*)"after cinfo" + call read_general_data(*10) +!write(iout,*)"after read_gen" + call flush(iout) + call molread(*10) +!write(iout,*)"after molread" + call flush(iout) +#ifdef MPI + write (iout,*) "Calling proc_groups" + call proc_groups + write (iout,*) "proc_groups exited" + call flush(iout) +#endif +!el---------- + call alloc_wham_arrays +!el---------- + do ipar=1,nParmSet + write (iout,*) "Calling parmread",ipar + call parmread(ipar,*10) + if (.not.separate_parset) then + call store_parm(ipar) + write (iout,*) "Finished storing parameters",ipar + else if (ipar.eq.myparm) then + call store_parm(1) + write (iout,*) "Finished storing parameters",ipar + endif + call flush(iout) + enddo + call read_efree(*10) + write (iout,*) "Finished READ_EFREE" + call flush(iout) + call read_protein_data(*10) + write (iout,*) "Finished READ_PROTEIN_DATA" + call flush(iout) + if (indpdb.gt.0) then + call promienie + call read_compar + call read_ref_structure(*10) +!write(iout,*)"before proc_cont, define frag" + call proc_cont + call fragment_list + if (constr_dist.gt.0) call read_dist_constr + endif + write (iout,*) "Begin read_database" + call flush(iout) + call read_database(*10) + write (iout,*) "Finished read_database" + call flush(iout) + if (separate_parset) nparmset=1 + do islice=1,nslice + if (ntot(islice).gt.0) then +#ifdef MPI + call work_partition(islice,.true.) + write (iout,*) "work_partition OK" + call flush(iout) +#endif + write (iout,*) "call enecalc",islice,nslice + call enecalc(islice,*10) + write (iout,*) "enecalc OK" + call flush(iout) + call WHAMCALC(islice,*10) + write (iout,*) "wham_calc OK" + call flush(iout) + call write_dbase(islice,*10) + write (iout,*) "write_dbase OK" + call flush(iout) + if (ensembles.gt.0) then + call make_ensembles(islice,*10) + write (iout,*) "make_ensembles OK" + call flush(iout) + endif + endif + enddo +#ifdef MPI + call MPI_Finalize( IERROR ) +#endif + stop + 10 write (iout,*) "Error termination of the program" +#ifdef MPI + call MPI_Finalize( IERROR ) +#endif + stop + end program wham_multparm +!------------------------------------------------------------------------------ +! +!------------------------------------------------------------------------------ +#ifdef MPI + subroutine proc_groups +! Split the processors into the Master and Workers group, if needed. + use io_units + use MPI_data + use wham_data + + implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" +! include "COMMON.IOUNITS" +! include "COMMON.MPI" +! include "COMMON.FREE" + include "mpif.h" + integer :: n,chunk,i,j,ii,remainder + integer :: kolorW,key,ierror,errcode + logical :: lprint + lprint=.true. +! +! Split the communicator if independent runs for different parameter +! sets will be performed. +! + if (nparmset.eq.1 .or. .not.separate_parset) then + WHAM_COMM = MPI_COMM_WORLD + else if (separate_parset) then + if (nprocs.lt.nparmset) then + write (iout,*) & + "*** Cannot split parameter sets for fewer processors than sets",& + nprocs,nparmset + call MPI_Finalize(ierror) + stop + endif + write (iout,*) "nparmset",nparmset + nprocs = nprocs/nparmset + kolorW = me/nprocs + key = mod(me,nprocs) + write (iout,*) "My old rank",me," kolor",kolorW," key",key + call MPI_Comm_split(MPI_COMM_WORLD,kolorW,key,WHAM_COMM,ierror) + call MPI_Comm_size(WHAM_COMM,nprocs,ierror) + call MPI_Comm_rank(WHAM_COMM,me,ierror) + write (iout,*) "My new rank",me," comm size",nprocs + write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,& + " WHAM_COMM",WHAM_COMM + myparm=kolorW+1 + write (iout,*) "My parameter set is",myparm + call flush(iout) + else + myparm=nparmset + endif + Me1 = Me + Nprocs1 = Nprocs + return + end subroutine proc_groups +#endif +!------------------------------------------------------------------------------ +#ifdef AIX + subroutine flush(iu) + call flush_(iu) + return + end subroutine flush +#endif +!----------------------------------------------------------------------------- + subroutine promienie(*) + + use io_units + use names + use io_base, only:ucase + use energy_data, only:sigma0,dsc,dsc_inv + use wham_data + use w_compar_data + implicit none +! include 'DIMENSIONS' +! include 'COMMON.CONTROL' +! include 'COMMON.INTERACT' +! include 'COMMON.IOUNITS' +! include 'COMMON.CONTPAR' +! include 'COMMON.LOCAL' + integer ::i,j + real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6) + character(len=8) :: contfunc + character(len=8) :: contfuncid(5)=reshape((/'GB ',& + 'DIST ','CEN ','ODC ','SIG '/),shape(contfuncid)) +!el character(len=8) ucase + call getenv("CONTFUNC",contfunc) + contfunc=ucase(contfunc) + do icomparfunc=1,5 + if (contfunc.eq.contfuncid(icomparfunc)) goto 10 + enddo + 10 continue + write (iout,*) "Sidechain contact function is ",contfunc,& + "icomparfunc",icomparfunc + do i=1,ntyp + do j=1,ntyp + if (icomparfunc.lt.3) then + read(isidep1,*) chi_comp(i,j),chip_comp(i,j),sig_comp(i,j),& + sc_cutoff(i,j) + else if (icomparfunc.lt.5) then + read(isidep1,*) sc_cutoff(i,j) + else if (icomparfunc.eq.5) then + sc_cutoff(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2)*facont + else + write (iout,*) "Error - Unknown contact function" + return 1 + endif + enddo + enddo + close (isidep1) + do i=1,ntyp1 + if (i.eq.10 .or. i.eq.ntyp1) then + dsc_inv(i)=0.0d0 + else + dsc_inv(i)=1.0d0/dsc(i) + endif + enddo + return + end subroutine promienie +!----------------------------------------------------------------------------- + subroutine alloc_wham_arrays + + use names + use geometry_data, only:nres + use energy_data, only:maxcont + use wham_data + use w_compar_data + integer :: i,j,k,l +!------------------------- +! COMMON.FREE +! common /wham/ + allocate(stot(nslice)) !(maxslice) + do i=1,nslice + stot(i)=0 + enddo + allocate(Kh(nQ,MaxR,MaxT_h,nParmSet),q0(nQ,MaxR,MaxT_h,nParmSet))!(MaxQ,MaxR,MaxT_h,max_parm) + allocate(f(maxR,maxT_h,nParmSet)) !(maxR,maxT_h,max_parm) + allocate(beta_h(maxT_h,nParmSet)) !(MaxT_h,max_parm) + allocate(nR(maxT_h,nParmSet),nRR(maxT_h,nParmSet)) !(maxT_h,max_parm) + allocate(snk(MaxR,MaxT_h,nParmSet,nSlice)) !(MaxR,MaxT_h,max_parm,MaxSlice) +! do i=1,MaxR +! do j=1,MaxT_h +! do k=1,nParmSet +! do l=1,nSlice +! snk(i,j,k,l)=0 +! enddo +! enddo +! enddo +! enddo + + allocate(totraj(maxR,nParmSet)) !(maxR,max_parm) + + allocate(nT_h(nParmSet))!(max_parm) + allocate(replica(nParmSet)) + allocate(umbrella(nParmSet)) + allocate(read_iset(nParmSet)) +! allocate(nT_h(nParmSet)) +!------------------------- +! COMMON.PROT +! common /protein/ + allocate(ntot(nslice)) !(maxslice) +! allocatable :: isampl !(max_parm) +!------------------------- +! COMMON.PROTFILES +! common /protfil/ + allocate(protfiles(maxfile_prot,2,MaxR,MaxT_h,nParmSet)) !(maxfile_prot,2,MaxR,MaxT_h,Max_Parm) + allocate(nfile_bin(MaxR,MaxT_h,nParmSet)) + allocate(nfile_asc(MaxR,MaxT_h,nParmSet)) + allocate(nfile_cx(MaxR,MaxT_h,nParmSet)) + allocate(rec_start(MaxR,MaxT_h,nParmSet)) + allocate(rec_end(MaxR,MaxT_h,nParmSet)) !(MaxR,MaxT_h,Max_Parm) +!------------------------- +! COMMON.OBCINKA +! common /obcinka/ + allocate(time_start_collect(maxR,MaxT_h,nParmSet)) + allocate(time_end_collect(maxR,MaxT_h,nParmSet)) !(maxR,MaxT_h,Max_Parm) +!------------------------- +! COMMON.CONTPAR +! common /contpar/ + allocate(sig_comp(ntyp,ntyp),chi_comp(ntyp,ntyp),& + chip_comp(ntyp,ntyp),sc_cutoff(ntyp,ntyp)) !(ntyp,ntyp) +!------------------------- +! COMMON.PEPTCONT +! common /peptcont/ + allocate(icont_pept_ref(2,maxcont)) !(2,maxcont) +! allocate(ncont_frag_ref()) !(mmaxfrag) +! allocate(icont_frag_ref(2,maxcont)) !(2,maxcont,mmaxfrag) + allocate(isec_ref(nres)) !(maxres) +!------------------------- +! COMMON.VAR +! Angles from experimental structure +! common /varref/ + allocate(vbld_ref(nres),theta_ref(nres),& + phi_ref(nres),alph_ref(nres),omeg_ref(nres)) !(maxres) +!------------------------- + end subroutine alloc_wham_arrays +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- diff --git a/source/wham/wham_calc.f90 b/source/wham/wham_calc.f90 new file mode 100644 index 0000000..08e166c --- /dev/null +++ b/source/wham/wham_calc.f90 @@ -0,0 +1,1259 @@ + module wham_calc +!----------------------------------------------------------------------------- + use io_units + use wham_data +! + use ene_calc +#ifdef MPI + use MPI_data +! include "COMMON.MPI" +#endif + implicit none +!----------------------------------------------------------------------------- +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- + + subroutine WHAMCALC(islice,*) +! Weighed Histogram Analysis Method (WHAM) code +! Written by A. Liwo based on the work of Kumar et al., +! J.Comput.Chem., 13, 1011 (1992) +! +! 2/1/05 Multiple temperatures allowed. +! 2/2/05 Free energies calculated directly from data points +! acc. to Eq. (21) of Kumar et al.; final histograms also +! constructed based on this equation. +! 2/12/05 Multiple parameter sets included +! +! 2/2/05 Parallel version +! use wham_data +! use io_units + use names + use io_base, only:ilen + use energy_data +#ifdef MPI + include "mpif.h" +#endif +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" + integer,parameter :: NGridT=400 + integer,parameter :: MaxBinRms=100,MaxBinRgy=100 + integer,parameter :: MaxHdim=200 +! parameter (MaxHdim=200000) + integer,parameter :: maxinde=200 +#ifdef MPI + integer :: ierror,errcode,status(MPI_STATUS_SIZE) +#endif +! include "COMMON.CONTROL" +! include "COMMON.IOUNITS" +! include "COMMON.FREE" +! include "COMMON.ENERGIES" +! include "COMMON.FFIELD" +! include "COMMON.SBRIDGE" +! include "COMMON.PROT" +! include "COMMON.ENEPS" + integer,parameter :: MaxPoint=MaxStr,& + MaxPointProc=MaxStr_Proc + real(kind=8),parameter :: finorm_max=1.0d0 + real(kind=8) :: potfac,entmin,entmax,expfac,vf + integer :: islice + integer :: i,ii,j,jj,k,kk,l,m,ind,iter,t,tmax,ient,ientmax,iln + integer :: start,end,iharm,ib,iib,nbin1,nbin,nbin_rms,nbin_rgy,& + nbin_rmsrgy,liczbaW,iparm,nFi,indrgy,indrms + integer :: htot(0:MaxHdim),histent(0:2000) + real(kind=8) :: v(MaxPointProc,MaxR,MaxT_h,nParmSet) !(MaxPointProc,MaxR,MaxT_h,Max_Parm) + real(kind=8) :: energia(0:n_ene) +!el real(kind=8) :: energia(0:max_ene) +#ifdef MPI + integer :: tmax_t,upindE_p + real(kind=8) :: fi_p(MaxR,MaxT_h,nParmSet) !(MaxR,MaxT_h,Max_Parm) + real(kind=8),dimension(0:nGridT,nParmSet) :: sumW_p,sumE_p,& + sumEbis_p,sumEsq_p !(0:nGridT,Max_Parm) + real(kind=8),dimension(MaxQ1,0:nGridT,nParmSet) :: sumQ_p,& + sumQsq_p,sumEQ_p,sumEprim_p !(MaxQ1,0:nGridT,Max_Parm) + real(kind=8) :: hfin_p(0:MaxHdim,maxT_h),& + hfin_ent_p(0:MaxHdim),histE_p(0:maxindE),sumH,& + hrmsrgy_p(0:MaxBinRgy,0:MaxBinRms,maxT_h) + real(kind=8) :: rgymin_t,rmsmin_t,rgymax_t,rmsmax_t + real(kind=8) :: potEmin_t,entmin_p,entmax_p + integer :: histent_p(0:2000) + logical :: lprint=.true. +#endif + real(kind=8) :: delta_T=1.0d0,iientmax + real(kind=8) :: rgymin,rmsmin,rgymax,rmsmax + real(kind=8),dimension(0:nGridT,nParmSet) :: sumW,sumE,& + sumEsq,sumEprim,sumEbis !(0:NGridT,Max_Parm) + real(kind=8),dimension(MaxQ1,0:nGridT,nParmSet) :: sumQ,& + sumQsq,sumEQ !(MaxQ1,0:NGridT,Max_Parm) + real(kind=8) :: betaT,weight,econstr + real(kind=8) :: fi(MaxR,MaxT_h,nParmSet),& !(MaxR,maxT_h,Max_Parm) + ddW,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 + real(kind=8) :: 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 + real(kind=8) :: etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors,& + escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,& + eello_turn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor + + integer :: ind_point(maxpoint),upindE,indE + character(len=16) :: plik + character(len=1) :: licz1 + character(len=2) :: licz2 + character(len=3) :: licz3 + character(len=128) :: nazwa +! integer ilen +! external ilen +!el ientmax=0 +!el ent=0.0d0 + write(licz2,'(bz,i2.2)') islice + nbin1 = 1.0d0/delta + write (iout,'(//80(1h-)/"Solving WHAM equations for slice",& + i2/80(1h-)//)') islice + write (iout,*) "delta",delta," nbin1",nbin1 + write (iout,*) "MaxN",MaxN," MaxQ",MaxQ," MaHdim",MaxHdim + call flush(iout) + dmin=0.0d0 + tmax=0 + potEmin=1.0d10 + rgymin=1.0d10 + rmsmin=1.0d10 + rgymax=0.0d0 + rmsmax=0.0d0 + do t=0,MaxN + htot(t)=0 + enddo +#ifdef MPI + do i=1,scount(me1) +#else + do i=1,ntot(islice) +#endif + do j=1,nParmSet + if (potE(i,j).le.potEmin) potEmin=potE(i,j) + enddo + if (q(nQ+1,i).lt.rmsmin) rmsmin=q(nQ+1,i) + if (q(nQ+1,i).gt.rmsmax) rmsmax=q(nQ+1,i) + if (q(nQ+2,i).lt.rgymin) rgymin=q(nQ+2,i) + if (q(nQ+2,i).gt.rgymax) rgymax=q(nQ+2,i) + ind_point(i)=0 + do j=nQ,1,-1 + ind=(q(j,i)-dmin+1.0d-8)/delta + if (j.eq.1) then + ind_point(i)=ind_point(i)+ind + else + ind_point(i)=ind_point(i)+nbin1**(j-1)*ind + endif +! write (iout,*) "i",i," j",j," q",q(j,i)," ind_point", +! & ind_point(i) + 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) +#ifdef MPI + write (iout,*) "Processor",me1 + call flush(iout) + call MPI_Abort(MPI_COMM_WORLD, Ierror, Errcode ) +#endif + stop + endif + enddo ! j + if (ind_point(i).gt.tmax) tmax=ind_point(i) + htot(ind_point(i))=htot(ind_point(i))+1 +#ifdef DEBUG + write (iout,*) "i",i,"q",(q(j,i),j=1,nQ)," ind",ind_point(i),& + " htot",htot(ind_point(i)) + call flush(iout) +#endif + enddo ! i + call flush(iout) + + nbin=nbin1**nQ-1 + write (iout,'(a)') "Numbers of counts in Q bins" + do t=0,tmax + if (htot(t).gt.0) then + write (iout,'(i15,$)') t + liczbaW=t + do j=1,nQ + jj = mod(liczbaW,nbin1) + liczbaW=liczbaW/nbin1 + write (iout,'(i5,$)') jj + enddo + write (iout,'(i8)') htot(t) + endif + enddo + do iparm=1,nParmSet + write (iout,'(a,i3)') "Number of data points for parameter set",& + iparm + write (iout,'(i7,$)') ((snk(m,ib,iparm,islice),m=1,nr(ib,iparm)),& + ib=1,nT_h(iparm)) + write (iout,'(i8)') stot(islice) + write (iout,'(a)') + enddo + call flush(iout) + +#ifdef MPI + call MPI_AllReduce(tmax,tmax_t,1,MPI_INTEGER,MPI_MAX,& + WHAM_COMM,IERROR) + tmax=tmax_t + call MPI_AllReduce(potEmin,potEmin_t,1,MPI_DOUBLE_PRECISION,& + MPI_MIN,WHAM_COMM,IERROR) + call MPI_AllReduce(rmsmin,rmsmin_t,1,MPI_DOUBLE_PRECISION,& + MPI_MIN,WHAM_COMM,IERROR) + call MPI_AllReduce(rmsmax,rmsmax_t,1,MPI_DOUBLE_PRECISION,& + MPI_MAX,WHAM_COMM,IERROR) + call MPI_AllReduce(rgymin,rgymin_t,1,MPI_DOUBLE_PRECISION,& + MPI_MIN,WHAM_COMM,IERROR) + call MPI_AllReduce(rgymax,rgymax_t,1,MPI_DOUBLE_PRECISION,& + MPI_MAX,WHAM_COMM,IERROR) + potEmin=potEmin_t/2 + rgymin=rgymin_t + rgymax=rgymax_t + rmsmin=rmsmin_t + rmsmax=rmsmax_t + write (iout,*) "potEmin",potEmin +#endif + rmsmin=deltrms*dint(rmsmin/deltrms) + rmsmax=deltrms*dint(rmsmax/deltrms) + rgymin=deltrms*dint(rgymin/deltrgy) + rgymax=deltrms*dint(rgymax/deltrgy) + nbin_rms=(rmsmax-rmsmin)/deltrms + nbin_rgy=(rgymax-rgymin)/deltrgy + write (iout,*) "rmsmin",rmsmin," rmsmax",rmsmax," rgymin",rgymin,& + " rgymax",rgymax," nbin_rms",nbin_rms," nbin_rgy",nbin_rgy + nFi=0 + do i=1,nParmSet + do j=1,nT_h(i) + nFi=nFi+nR(j,i) + enddo + enddo + write (iout,*) "nFi",nFi +! Compute the Boltzmann factor corresponing to restrain potentials in different +! simulations. +#ifdef MPI + do i=1,scount(me1) +#else + do i=1,ntot(islice) +#endif +! 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) +!#endif + call restore_parm(iparm) +!#ifdef DEBUG + write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,& + wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,& + wtor_d,wsccor,wbond +!#endif + do ib=1,nT_h(iparm) +!el old rascale weights +! +! if (rescale_modeW.eq.1) then +! quot=1.0d0/(beta_h(ib,iparm)*1.987D-3*T0) +! quotl=1.0d0 +! kfacl=1.0d0 +! do l=1,5 +! quotl1=quotl +! quotl=quotl*quot +! kfacl=kfacl*kfac +! fT(l)=kfacl/(kfacl-1.0d0+quotl) +! enddo +!#if defined(FUNCTH) +! tt = 1.0d0/(beta_h(ib,iparm)*1.987D-3) +! ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/320.0d0 +!#elif defined(FUNCT) +! ft(6)=1.0d0/(beta_h(ib,iparm)*1.987D-3*T0) +!#else +! ft(6)=1.0d0 +!#endif +! else if (rescale_modeW.eq.2) then +! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3) +! quotl=1.0d0 +! do l=1,5 +! quotl=quotl*quot +! fT(l)=1.12692801104297249644d0/ & +! dlog(dexp(quotl)+dexp(-quotl)) +! enddo +!#if defined(FUNCTH) +! tt = 1.0d0/(beta_h(ib,iparm)*1.987D-3) +! ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/320.0d0 +!#elif defined(FUNCT) +! ft(6)=1.0d0/(beta_h(ib,iparm)*1.987D-3*T0) +!#else +! ft(6)=1.0d0 +!#endif +! write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft +! else if (rescale_modeW.eq.0) then +! do l=1,6 +! fT(l)=1.0d0 +! enddo +! else +! write (iout,*) "Error in WHAM_CALC: wrong RESCALE_MODE",& +! rescale_modeW +! call flush(iout) +! return 1 +! endif +! el end old rescale weights + call rescale_weights(1.0d0/(beta_h(ib,iparm)*1.987D-3)) + +! call etot(enetb(0,i,iparm)) + evdw=enetb(1,i,iparm) +! evdw_t=enetb(21,i,iparm) + evdw_t=enetb(20,i,iparm) +#ifdef SCP14 +! evdw2_14=enetb(17,i,iparm) + evdw2_14=enetb(18,i,iparm) + evdw2=enetb(2,i,iparm)+evdw2_14 +#else + evdw2=enetb(2,i,iparm) + evdw2_14=0.0d0 +#endif +#ifdef SPLITELE + ees=enetb(3,i,iparm) + evdw1=enetb(16,i,iparm) +#else + ees=enetb(3,i,iparm) + evdw1=0.0d0 +#endif + ecorr=enetb(4,i,iparm) + ecorr5=enetb(5,i,iparm) + ecorr6=enetb(6,i,iparm) + eel_loc=enetb(7,i,iparm) + eello_turn3=enetb(8,i,iparm) + eello_turn4=enetb(9,i,iparm) + eello_turn6=enetb(10,i,iparm) + ebe=enetb(11,i,iparm) + escloc=enetb(12,i,iparm) + etors=enetb(13,i,iparm) + etors_d=enetb(14,i,iparm) + ehpb=enetb(15,i,iparm) +! estr=enetb(18,i,iparm) + estr=enetb(17,i,iparm) +! esccor=enetb(19,i,iparm) + esccor=enetb(21,i,iparm) +! edihcnstr=enetb(20,i,iparm) + edihcnstr=enetb(19,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,& + etors,etors_d,eello_turn3,eello_turn4,esccor +#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 & +! +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 +!#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 +!#endif + +#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*eello_turn6+wel_loc*eel_loc & + +edihcnstr+wtor_d*etors_d+wsccor*esccor & + +wbond*estr +#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*eello_turn6+wel_loc*eel_loc+edihcnstr & + +wtor_d*etors_d+wsccor*esccor & + +wbond*estr +#endif + +#ifdef DEBUG + write (iout,*) i,iparm,1.0d0/(beta_h(ib,iparm)*1.987D-3),& + etot,potEmin +#endif +#ifdef DEBUG + if (iparm.eq.1 .and. ib.eq.1) then + write (iout,*)"Conformation",i + energia(0)=etot + do k=1,max_ene + energia(k)=enetb(k,i,iparm) + enddo +! call enerprint(energia(0),fT) + call enerprint(energia(0)) + endif +#endif + do kk=1,nR(ib,iparm) + Econstr=0.0d0 + do j=1,nQ + ddW = q(j,i) + Econstr=Econstr+Kh(j,kk,ib,iparm) & + *(ddW-q0(j,kk,ib,iparm))**2 + enddo + v(i,kk,ib,iparm)= & + -beta_h(ib,iparm)*(etot-potEmin+Econstr) +#ifdef DEBUG + write (iout,'(4i5,4e15.5)') i,kk,ib,iparm,& + etot,potEmin,etot-potEmin,v(i,kk,ib,iparm) +#endif + enddo ! kk + enddo ! ib + enddo ! iparm + enddo ! i +! Simple iteration to calculate free energies corresponding to all simulation +! runs. + do iter=1,maxit + +! Compute new free-energy values corresponding to the righ-hand side of the +! equation and their derivatives. + write (iout,*) "------------------------fi" +#ifdef MPI + do t=1,scount(me1) +#else + do t=1,ntot(islice) +#endif + vmax=-1.0d+20 + do i=1,nParmSet + do k=1,nT_h(i) + do l=1,nR(k,i) + vf=v(t,l,k,i)+f(l,k,i) + if (vf.gt.vmax) vmax=vf + enddo + enddo + enddo + denom=0.0d0 + do i=1,nParmSet + do k=1,nT_h(i) + do l=1,nR(k,i) + aux=f(l,k,i)+v(t,l,k,i)-vmax + if (aux.gt.-200.0d0) & + denom=denom+snk(l,k,i,islice)*dexp(aux) + enddo + enddo + enddo + entfac(t)=-dlog(denom)-vmax +#ifdef DEBUG + 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 + 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)) +#ifdef DEBUG + write (iout,'(4i5,3e15.5)') t,ii,iib,iparm,& + v(t,ii,iib,iparm),entfac(t),fi_p(ii,iib,iparm) +#endif + enddo +#else + 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)) + enddo +#endif + enddo ! ii + enddo ! iib + enddo ! iparm + +#ifdef MPI +#ifdef DEBUG + write (iout,*) "fi before MPI_Reduce me",me,' master',master + do iparm=1,nParmSet + do ib=1,nT_h(nparmset) + write (iout,*) "iparm",iparm," ib",ib + write (iout,*) "beta=",beta_h(ib,iparm) + write (iout,'(8e15.5)') (fi_p(i,ib,iparm),i=1,nR(ib,iparm)) + 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 + 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) +#ifdef DEBUG + write (iout,*) "fi after MPI_Reduce nparmset",nparmset + do iparm=1,nParmSet + write (iout,*) "iparm",iparm + do ib=1,nT_h(iparm) + write (iout,*) "beta=",beta_h(ib,iparm) + write (iout,'(8e15.5)') (fi(i,ib,iparm),i=1,nR(ib,iparm)) + enddo + enddo +#endif + if (me1.eq.Master) then +#endif + avefi=0.0d0 + 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)) + avefi=avefi+fi(i,ib,iparm) + enddo + enddo + enddo + avefi=avefi/nFi + do iparm=1,nParmSet + write (iout,*) "Parameter set",iparm + do ib =1,nT_h(iparm) + write (iout,*) "beta=",beta_h(ib,iparm) + 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)) + enddo + enddo + +! Compute the norm of free-energy increments. + finorm=0.0d0 + do iparm=1,nParmSet + do ib=1,nT_h(iparm) + do i=1,nR(ib,iparm) + finorm=finorm+dabs(fi(i,ib,iparm)-f(i,ib,iparm)) + f(i,ib,iparm)=fi(i,ib,iparm) + enddo + enddo + enddo + + write (iout,*) 'Iteration',iter,' finorm',finorm + +#ifdef MPI + endif + call MPI_Bcast(f(1,1,1),MaxR*MaxT_h*nParmSet,& + MPI_DOUBLE_PRECISION,Master,& + WHAM_COMM,IERROR) + call MPI_Bcast(finorm,1,MPI_DOUBLE_PRECISION,Master,& + WHAM_COMM,IERROR) +#endif +! Exit, if the increment norm is smaller than pre-assigned tolerance. + if (finorm.lt.fimin) then + write (iout,*) 'Iteration converged' + goto 20 + endif + + enddo ! iter + + 20 continue +! Now, put together the histograms from all simulations, in order to get the +! unbiased total histogram. +#ifdef MPI + do t=0,tmax + hfin_ent_p(t)=0.0d0 + enddo +#else + do t=0,tmax + hfin_ent(t)=0.0d0 + enddo +#endif + write (iout,*) "--------------hist" +#ifdef MPI + do iparm=1,nParmSet + do i=0,nGridT + sumW_p(i,iparm)=0.0d0 + sumE_p(i,iparm)=0.0d0 + sumEbis_p(i,iparm)=0.0d0 + sumEsq_p(i,iparm)=0.0d0 + do j=1,nQ+2 + sumQ_p(j,i,iparm)=0.0d0 + sumQsq_p(j,i,iparm)=0.0d0 + sumEQ_p(j,i,iparm)=0.0d0 + enddo + enddo + enddo + upindE_p=0 +#else + do iparm=1,nParmSet + do i=0,nGridT + sumW(i,iparm)=0.0d0 + sumE(i,iparm)=0.0d0 + sumEbis(i,iparm)=0.0d0 + sumEsq(i,iparm)=0.0d0 + do j=1,nQ+2 + sumQ(j,i,iparm)=0.0d0 + sumQsq(j,i,iparm)=0.0d0 + sumEQ(j,i,iparm)=0.0d0 + enddo + enddo + enddo + upindE=0 +#endif +! 8/26/05 entropy distribution +#ifdef MPI + entmin_p=1.0d10 + entmax_p=-1.0d10 + do t=1,scount(me1) +! ent=-dlog(entfac(t)) + ent=entfac(t) + if (ent.lt.entmin_p) entmin_p=ent + if (ent.gt.entmax_p) entmax_p=ent + enddo + write (iout,*) "entmin",entmin_p," entmax",entmax_p +! write (iout,*) "entmin_p",entmin_p," entmax_p",entmax_p + call flush(iout) + call MPI_Allreduce(entmin_p,entmin,1,MPI_DOUBLE_PRECISION,MPI_MIN,& + WHAM_COMM,IERROR) + call MPI_Allreduce(entmax_p,entmax,1,MPI_DOUBLE_PRECISION,MPI_MAX,& + WHAM_COMM,IERROR) + write (iout,*) "entmin",entmin_p," entmax",entmax_p +! write (iout,*) "entmin_p",entmin_p," entmax_p",entmax_p + ientmax=entmax-entmin +!iientmax=entmax-entmin !el +!write (iout,*) "ientmax",ientmax,entmax,entmin +!write (iout,*) "iientmax",iientmax + if (ientmax.gt.2000) ientmax=2000 + write (iout,*) "entmin",entmin," entmax",entmax," ientmax",ientmax + call flush(iout) + do t=1,scount(me1) +! ient=-dlog(entfac(t))-entmin + ient=entfac(t)-entmin + if (ient.le.2000) histent_p(ient)=histent_p(ient)+1 + enddo + call MPI_Allreduce(histent_p(0),histent(0),ientmax+1,MPI_INTEGER,& + MPI_SUM,WHAM_COMM,IERROR) + if (me1.eq.Master) then + write (iout,*) "Entropy histogram" + do i=0,ientmax + write(iout,'(f15.4,i10)') entmin+i,histent(i) + enddo + endif +#else + entmin=1.0d10 + entmax=-1.0d10 + do t=1,ntot(islice) + ent=entfac(t) + if (ent.lt.entmin) entmin=ent + if (ent.gt.entmax) entmax=ent + enddo + ientmax=-dlog(entmax)-entmin + if (ientmax.gt.2000) ientmax=2000 + do t=1,ntot(islice) + ient=entfac(t)-entmin + if (ient.le.2000) histent(ient)=histent(ient)+1 + enddo + write (iout,*) "Entropy histogram" + do i=0,ientmax + write(iout,'(2f15.4)') entmin+i,histent(i) + enddo +#endif + +#ifdef MPI + write (iout,*) "me1",me1," scount",scount(me1) !d + + do iparm=1,nParmSet + +#ifdef MPI + do ib=1,nT_h(iparm) + do t=0,tmax + hfin_p(t,ib)=0.0d0 + enddo + enddo + do i=1,maxindE + histE_p(i)=0.0d0 + enddo +#else + do ib=1,nT_h(iparm) + do t=0,tmax + hfin(t,ib)=0.0d0 + enddo + enddo + do i=1,maxindE + histE(i)=0.0d0 + enddo +#endif + do ib=1,nT_h(iparm) + do i=0,MaxBinRms + do j=0,MaxBinRgy + hrmsrgy(j,i,ib)=0.0d0 +#ifdef MPI + hrmsrgy_p(j,i,ib)=0.0d0 +#endif + enddo + enddo + enddo + + do t=1,scount(me1) +#else + do t=1,ntot(islice) +#endif + ind = ind_point(t) +#ifdef MPI + hfin_ent_p(ind)=hfin_ent_p(ind)+dexp(entfac(t)) +#else + hfin_ent(ind)=hfin_ent(ind)+dexp(entfac(t)) +#endif +! write (iout,'(2i5,20f8.2)') "debug",t,t,(enetb(k,t,iparm),k=1,21) + call restore_parm(iparm) +! evdw=enetb(21,t,iparm) + evdw=enetb(20,t,iparm) + evdw_t=enetb(1,t,iparm) +#ifdef SCP14 +! evdw2_14=enetb(17,t,iparm) + evdw2_14=enetb(18,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) + eello_turn6=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) + estr=enetb(17,t,iparm) +! esccor=enetb(19,t,iparm) + esccor=enetb(21,t,iparm) +! edihcnstr=enetb(20,t,iparm) + edihcnstr=enetb(19,t,iparm) + edihcnstr=0.0d0 + do k=0,nGridT + betaT=startGridT+k*delta_T + temper=betaT +!write(iout,*)"kkkkkkkk",betaT,startGridT,k,delta_T +!d fT=T0/betaT +!d ft=2*T0/(T0+betaT) + if (rescale_modeW.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_modeW.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_modeW.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_modeW + call flush(iout) + return 1 + endif +! write (iout,*) "ftprim",ftprim +! 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*eello_turn6+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*eello_turn6+ & + 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*eello_turn6+ & + 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+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*eello_turn6+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*eello_turn6+ & + 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*eello_turn6+ & + ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ & + ftprim(1)*wsccor*esccor +#endif + weight=dexp(-betaT*(etot-potEmin)+entfac(t)) +#ifdef DEBUG + write (iout,*) "iparm",iparm," t",t," betaT",betaT,& + " etot",etot," entfac",entfac(t),& + " weight",weight," ebis",ebis +#endif + etot=etot-temper*eprim +#ifdef MPI + sumW_p(k,iparm)=sumW_p(k,iparm)+weight + sumE_p(k,iparm)=sumE_p(k,iparm)+etot*weight + sumEbis_p(k,iparm)=sumEbis_p(k,iparm)+ebis*weight + sumEsq_p(k,iparm)=sumEsq_p(k,iparm)+etot**2*weight + do j=1,nQ+2 + sumQ_p(j,k,iparm)=sumQ_p(j,k,iparm)+q(j,t)*weight + sumQsq_p(j,k,iparm)=sumQsq_p(j,k,iparm)+q(j,t)**2*weight + sumEQ_p(j,k,iparm)=sumEQ_p(j,k,iparm) & + +etot*q(j,t)*weight + enddo +#else + sumW(k,iparm)=sumW(k,iparm)+weight + sumE(k,iparm)=sumE(k,iparm)+etot*weight + sumEbis(k,iparm)=sumEbis(k,iparm)+ebis*weight + sumEsq(k,iparm)=sumEsq(k,iparm)+etot**2*weight + do j=1,nQ+2 + sumQ(j,k,iparm)=sumQ(j,k,iparm)+q(j,t)*weight + sumQsq(j,k,iparm)=sumQsq(j,k,iparm)+q(j,t)**2*weight + sumEQ(j,k,iparm)=sumEQ(j,k,iparm) & + +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 + 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) + if (rmsrgymap) then + call MPI_Reduce(hrmsrgy_p(0,0,ib),hrmsrgy(0,0,ib),& + (MaxBinRgy+1)*(nbin_rms+1),MPI_DOUBLE_PRECISION,MPI_SUM,Master,& + WHAM_COMM,IERROR) + endif + enddo + call MPI_Reduce(upindE_p,upindE,1,& + MPI_INTEGER,MPI_MAX,Master,WHAM_COMM,IERROR) + call MPI_Reduce(histE_p(0),histE(0),maxindE,& + MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) + + if (me1.eq.master) then + + if (histout) then + + write (iout,'(6x,$)') + write (iout,'(f20.2,$)') (1.0d0/(1.987D-3*beta_h(ib,iparm)),& + ib=1,nT_h(iparm)) + write (iout,*) + + write (iout,'(/a)') 'Final histograms' + if (histfile) then + if (nslice.eq.1) then + if (separate_parset) then + write(licz3,"(bz,i3.3)") myparm + histname=prefix(:ilen(prefix))//'_par'//licz3//'.hist' + else + histname=prefix(:ilen(prefix))//'.hist' + endif + else + if (separate_parset) then + write(licz3,"(bz,i3.3)") myparm + histname=prefix(:ilen(prefix))//'_par'//licz3// & + '_slice_'//licz2//'.hist' + else + histname=prefix(:ilen(prefix))//'_slice_'//licz2//'.hist' + endif + endif +#if defined(AIX) || defined(PGI) + open (ihist,file=histname,position='append') +#else + open (ihist,file=histname,access='append') +#endif + endif + + do t=0,tmax + liczbaW=t + sumH=0.0d0 + do ib=1,nT_h(iparm) + sumH=sumH+hfin(t,ib) + enddo + if (sumH.gt.0.0d0) then + do j=1,nQ + jj = mod(liczbaW,nbin1) + liczbaW=liczbaW/nbin1 + write (iout,'(f6.3,$)') dmin+(jj+0.5d0)*delta + if (histfile) & + write (ihist,'(f6.3,$)') dmin+(jj+0.5d0)*delta + enddo + do ib=1,nT_h(iparm) + write (iout,'(e20.10,$)') hfin(t,ib) + if (histfile) write (ihist,'(e20.10,$)') hfin(t,ib) + enddo + write (iout,'(i5)') iparm + if (histfile) write (ihist,'(i5)') iparm + endif + enddo + + endif + + if (entfile) then + if (nslice.eq.1) then + if (separate_parset) then + write(licz3,"(bz,i3.3)") myparm + histname=prefix(:ilen(prefix))//"_par"//licz3//'.ent' + else + histname=prefix(:ilen(prefix))//'.ent' + endif + else + if (separate_parset) then + write(licz3,"(bz,i3.3)") myparm + histname=prefix(:ilen(prefix))//'par_'//licz3// & + '_slice_'//licz2//'.ent' + else + histname=prefix(:ilen(prefix))//'_slice_'//licz2//'.ent' + endif + endif +#if defined(AIX) || defined(PGI) + open (ihist,file=histname,position='append') +#else + open (ihist,file=histname,access='append') +#endif + write (ihist,'(a)') "# Microcanonical entropy" + do i=0,upindE + write (ihist,'(f8.0,$)') dint(potEmin)+i + if (histE(i).gt.0.0e0) then + write (ihist,'(f15.5,$)') dlog(histE(i)) + else + write (ihist,'(f15.5,$)') 0.0d0 + endif + enddo + write (ihist,*) + close(ihist) + endif + write (iout,*) "Microcanonical entropy" + do i=0,upindE + write (iout,'(f8.0,$)') dint(potEmin)+i + if (histE(i).gt.0.0e0) then + write (iout,'(f15.5,$)') dlog(histE(i)) + else + write (iout,'(f15.5,$)') 0.0d0 + endif + write (iout,*) + enddo + if (rmsrgymap) then + if (nslice.eq.1) then + if (separate_parset) then + write(licz3,"(bz,i3.3)") myparm + histname=prefix(:ilen(prefix))//'_par'//licz3//'.rmsrgy' + else + histname=prefix(:ilen(prefix))//'.rmsrgy' + endif + else + if (separate_parset) then + write(licz3,"(bz,i3.3)") myparm + histname=prefix(:ilen(prefix))//'_par'//licz3// & + '_slice_'//licz2//'.rmsrgy' + else + histname=prefix(:ilen(prefix))//'_slice_'//licz2//'.rmsrgy' + endif + endif +#if defined(AIX) || defined(PGI) + open (ihist,file=histname,position='append') +#else + open (ihist,file=histname,access='append') +#endif + do i=0,nbin_rms + do j=0,nbin_rgy + write(ihist,'(2f8.2,$)') & + rgymin+deltrgy*j,rmsmin+deltrms*i + do ib=1,nT_h(iparm) + if (hrmsrgy(j,i,ib).gt.0.0d0) then + write(ihist,'(e14.5,$)') & + -dlog(hrmsrgy(j,i,ib))/beta_h(ib,iparm) & + +potEmin + else + write(ihist,'(e14.5,$)') 1.0d6 + endif + enddo + write (ihist,'(i2)') iparm + enddo + enddo + close(ihist) + endif + endif + enddo ! iparm +#ifdef MPI + call MPI_Reduce(hfin_ent_p(0),hfin_ent(0),nbin,& + MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) + call MPI_Reduce(sumW_p(0,1),sumW(0,1),(nGridT+1)*nParmSet,& + MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) + call MPI_Reduce(sumE_p(0,1),sumE(0,1),(nGridT+1)*nParmSet,& + MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) + call MPI_Reduce(sumEbis_p(0,1),sumEbis(0,1),(nGridT+1)*nParmSet,& + MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) + call MPI_Reduce(sumEsq_p(0,1),sumEsq(0,1),(nGridT+1)*nParmSet,& + MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) + call MPI_Reduce(sumQ_p(1,0,1),sumQ(1,0,1),& + MaxQ1*(nGridT+1)*nParmSet,MPI_DOUBLE_PRECISION,MPI_SUM,Master,& + WHAM_COMM,IERROR) + call MPI_Reduce(sumQsq_p(1,0,1),sumQsq(1,0,1),& + MaxQ1*(nGridT+1)*nParmSet,MPI_DOUBLE_PRECISION,MPI_SUM,Master,& + WHAM_COMM,IERROR) + call MPI_Reduce(sumEQ_p(1,0,1),sumEQ(1,0,1),& + MaxQ1*(nGridT+1)*nParmSet,MPI_DOUBLE_PRECISION,MPI_SUM,Master,& + WHAM_COMM,IERROR) + if (me.eq.master) then +#endif + write (iout,'(/a)') 'Thermal characteristics of folding' + if (nslice.eq.1) then + nazwa=prefix + else + nazwa=prefix(:ilen(prefix))//"_slice_"//licz2 + endif + iln=ilen(nazwa) + if (nparmset.eq.1 .and. .not.separate_parset) then + nazwa=nazwa(:iln)//".thermal" + else if (nparmset.eq.1 .and. separate_parset) then + write(licz3,"(bz,i3.3)") myparm + nazwa=nazwa(:iln)//"_par_"//licz3//".thermal" + endif + do iparm=1,nParmSet + if (nparmset.gt.1) then + write(licz3,"(bz,i3.3)") iparm + nazwa=nazwa(:iln)//"_par_"//licz3//".thermal" + endif + open(34,file=nazwa) + if (separate_parset) then + write (iout,'(a,i3)') "Parameter set",myparm + else + write (iout,'(a,i3)') "Parameter set",iparm + endif + do i=0,NGridT + sumE(i,iparm)=sumE(i,iparm)/sumW(i,iparm) + sumEbis(i,iparm)=(startGridT+i*delta_T)*sumEbis(i,iparm)/ & + sumW(i,iparm) + sumEsq(i,iparm)=(sumEsq(i,iparm)/sumW(i,iparm) & + -sumE(i,iparm)**2)/(1.987D-3*(startGridT+i*delta_T)**2) + do j=1,nQ+2 + sumQ(j,i,iparm)=sumQ(j,i,iparm)/sumW(i,iparm) + sumQsq(j,i,iparm)=sumQsq(j,i,iparm)/sumW(i,iparm) & + -sumQ(j,i,iparm)**2 + 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* & + (startGridT+i*delta_T))+potEmin + write (iout,'(f7.1,2f15.5,$)') startGridT+i*delta_T,& + sumW(i,iparm),sumE(i,iparm) + write (iout,'(f10.5,$)') (sumQ(j,i,iparm),j=1,nQ+2) + write (iout,'(e15.5,$)') sumEsq(i,iparm)-sumEbis(i,iparm),& + (sumQsq(j,i,iparm),j=1,nQ+2),(sumEQ(j,i,iparm),j=1,nQ+2) + 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),& + (sumQsq(j,i,iparm),j=1,nQ+2),(sumEQ(j,i,iparm),j=1,nQ+2) + write (34,*) + call flush(34) + enddo + close(34) + enddo + if (histout) then + do t=0,tmax + if (hfin_ent(t).gt.0.0d0) then + liczbaW=t + jj = mod(liczbaW,nbin1) + write (iout,'(f6.3,e20.10," ent")') dmin+(jj+0.5d0)*delta,& + hfin_ent(t) + if (histfile) write (ihist,'(f6.3,e20.10," ent")') & + dmin+(jj+0.5d0)*delta,& + hfin_ent(t) + endif + enddo + if (histfile) close(ihist) + endif + +#ifdef ZSCORE +! Write data for zscore + if (nslice.eq.1) then + zscname=prefix(:ilen(prefix))//".zsc" + else + zscname=prefix(:ilen(prefix))//"_slice_"//licz2//".zsc" + endif +#if defined(AIX) || defined(PGI) + open (izsc,file=prefix(:ilen(prefix))//'.zsc',position='append') +#else + open (izsc,file=prefix(:ilen(prefix))//'.zsc',access='append') +#endif + write (izsc,'("NQ=",i1," NPARM=",i1)') nQ,nParmSet + do iparm=1,nParmSet + write (izsc,'("NT=",i1)') nT_h(iparm) + do ib=1,nT_h(iparm) + write (izsc,'("TEMP=",f6.1," NR=",i2," SNK=",$)') & + 1.0d0/(beta_h(ib,iparm)*1.987D-3),nR(ib,iparm) + jj = min0(nR(ib,iparm),7) + write (izsc,'(i8,$)') (snk(i,ib,iparm,islice),i=1,jj) + write (izsc,'(a1,$)') (" ",i=22+8*jj+1,79) + write (izsc,'("&")') + if (nR(ib,iparm).gt.7) then + do ii=8,nR(ib,iparm),9 + jj = min0(nR(ib,iparm),ii+8) + write (izsc,'(i8,$)') (snk(i,ib,iparm,islice),i=ii,jj) + write (izsc,'(a1,$') (" ",i=(jj-ii+1)*8+1,79) + write (izsc,'("&")') + enddo + endif + write (izsc,'("FI=",$)') + jj=min0(nR(ib,iparm),7) + write (izsc,'(f10.5,$)') (fi(i,ib,iparm),i=1,jj) + write (izsc,'(a1,$)') (" ",i=3+10*jj+1,79) + write (izsc,'("&")') + if (nR(ib,iparm).gt.7) then + do ii=8,nR(ib,iparm),9 + jj = min0(nR(ib,iparm),ii+8) + write (izsc,'(f10.5,$)') (fi(i,ib,iparm),i=ii,jj) + if (jj.eq.nR(ib,iparm)) then + write (izsc,*) + else + write (izsc,'(a1,$)') (" ",i=10*(jj-ii+1)+1,79) + write (izsc,'(t80,"&")') + endif + enddo + endif + do i=1,nR(ib,iparm) + write (izsc,'("KH=",$)') + write (izsc,'(f7.2,$)') (Kh(j,i,ib,iparm),j=1,nQ) + write (izsc,'(" Q0=",$)') + write (izsc,'(f7.5,$)') (q0(j,i,ib,iparm),j=1,nQ) + write (izsc,*) + enddo + enddo + enddo + close(izsc) +#endif +#ifdef MPI + endif +#endif + return + end subroutine WHAMCALC +!----------------------------------------------------------------------------- + end module wham_calc + diff --git a/source/wham/wham_data.f90 b/source/wham/wham_data.f90 new file mode 100644 index 0000000..1dfc3bc --- /dev/null +++ b/source/wham/wham_data.f90 @@ -0,0 +1,132 @@ + module wham_data +!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- + integer,parameter :: max_eneW=21 + integer,parameter :: maxQ=1 + integer,parameter :: maxQ1=MaxQ+2 + integer,parameter :: max_parm=1 + integer,parameter :: MaxSlice=40 + integer,parameter :: MaxN=100 + integer,parameter :: MaxR=1 + integer,parameter :: MaxT_h=32 + integer,parameter :: maxstr=200000 + integer,parameter :: maxfile_prot=100 +! Maximum number of structures to be dealt with by one processor + integer,parameter :: maxstr_proc=10000 + integer :: n_eneW + integer :: ijunk +!--------------------------------------------------------------------------- + +!--------------------------------------------------------------------------- +! DIMENSIONS.COMPAR +! Array dimensions for level-based conformation comparison program: +! +! Max. number of conformations in the data set. +! +! integer maxconf +! PARAMETER (MAXCONF=maxstr_proc) +! +! Max. number levels of comparison +! +! integer maxlevel +! PARAMETER (MAXLEVEL=3) +! +! Max. number of fragments at a given level of comparison +! + integer,parameter :: maxfrag=30 + integer,parameter :: MMAXFRAG=MAXFRAG*(MAXFRAG+1)/2 +! +! Max. number of pieces forming a substructure to be compared +! + integer,parameter :: MAXPIECE=20 +! +!--------------------------------------------------------------------------- +!--------------------------------------------------------------------------- +! COMMON.WEIGHTS +! common /chujec/ + real(kind=8),dimension(:),allocatable :: ww,ww0,ww_low,ww_up,& + ww_orig !(max_ene) + real(kind=8),dimension(:),allocatable :: x_orig,x_up,x_low !(max_paropt) + real(kind=8),dimension(2,2) :: epp_low,epp_up,rpp_low,rpp_up,& + elpp6_low,elpp6_up,elpp3_low,elpp3_up + real(kind=8),dimension(13,3) :: b_low,b_up + real(kind=8),dimension(:,:),allocatable :: epscp_low,epscp_up,& + rscp_low,rscp_up !(0:ntyp,2) + real(kind=8),dimension(:),allocatable :: epss_low,epss_up !(ntyp) + real(kind=8),dimension(:),allocatable :: epsp_low,epsp_up !(nntyp) + real(kind=8),dimension(:,:),allocatable :: xm,xm1,& + xm2 !(max_paropt,0:maxprot) + + integer,dimension(:),allocatable :: imask,iwW !(max_ene) + integer :: nsingle_sc,npair_sc + integer,dimension(:),allocatable :: ityp_ssc !(ntyp) + integer,dimension(:,:),allocatable :: ityp_psc !(2,nntyp) + integer :: mask_elec(2,2,4),mask_fourier(13,3),mod_fourier(0:3) + integer,dimension(:,:,:),allocatable :: mask_scp !(0:ntyp,2,2) + integer,dimension(:,:),allocatable :: indz !(maxbatch+1,maxprot) + logical :: mod_other_params,mod_elec,mod_scp,mod_side +!--------------------------------------------------------------------------- +! COMMON.FREE +! common /wham/ + integer :: nQ,nparmset,rescale_modeW,iparmprint,myparm + integer,dimension(:),allocatable :: stot !(maxslice) + logical :: hamil_rep,separate_parset + real(kind=8),dimension(:,:,:,:),allocatable :: Kh,q0 !(MaxQ,MaxR,MaxT_h,max_parm) + real(kind=8) :: delta,deltrms,deltrgy,fimin + real(kind=8),dimension(:,:,:),allocatable :: f !(maxR,maxT_h,max_parm) + real(kind=8),dimension(:,:),allocatable :: beta_h !(MaxT_h,max_parm) + integer,dimension(:,:),allocatable :: nR,nRR !(maxT_h,max_parm) + integer,dimension(:,:,:,:),allocatable :: snk !(MaxR,MaxT_h,max_parm,MaxSlice) + integer,dimension(:),allocatable :: nT_h !(max_parm) + integer :: maxit + integer,dimension(:,:),allocatable :: totraj !(maxR,max_parm) + logical,dimension(:),allocatable :: replica,umbrella,read_iset !(max_parm) +!--------------------------------------------------------------------------- +! COMMON.PROT +! common /protein/ + integer,dimension(:),allocatable :: ntot !(maxslice) + integer,dimension(:),allocatable :: isampl !(max_parm) + integer :: nslice +!--------------------------------------------------------------------------- +! COMMON.PROTFILES +! common /protfil/ + character(len=80),dimension(:,:,:,:,:),allocatable :: protfiles !(maxfile_prot,2,MaxR,MaxT_h,Max_Parm) + character(len=80) :: bprotfiles + integer,dimension(:,:,:),allocatable :: nfile_bin,nfile_asc,& + nfile_cx,rec_start,rec_end !(MaxR,MaxT_h,Max_Parm) + integer :: lenrec,lenrec1,lenrec2 +!--------------------------------------------------------------------------- +! COMMON.ENERGIES +! common /energies/ + real(kind=8),dimension(:,:),allocatable :: potE !(MaxStr_Proc,Max_Parm) + real(kind=8),dimension(:),allocatable :: entfac !(MaxStr_Proc) + real(kind=8),dimension(:,:),allocatable :: q !(MaxQ+2,MaxStr_Proc) + real(kind=8),dimension(:,:,:),allocatable :: enetb !(max_ene,MaxStr_Proc,Max_Parm) + integer :: einicheck +!--------------------------------------------------------------------------- +! COMMON.CONTROL +! common /cntrl/ + logical :: punch_dist,print_rms,caonly,verbose,merge_helices,& + bxfile,cxfile,histfile,entfile,zscfile,rmsrgymap,& + with_dihed_constr,check_conf,histout + integer :: icomparfunc,pdbint,ensembles,constr_dist +!--------------------------------------------------------------------------- +! COMMON.OBCINKA +! common /obcinka/ + real(kind=8),dimension(:,:,:),allocatable :: time_start_collect,& + time_end_collect !(maxR,MaxT_h,Max_Parm) +!--------------------------------------------------------------------------- +! COMMON.PEPTCONT +! common /peptcont/ + integer :: ncont_pept_ref + integer,dimension(:,:),allocatable :: icont_pept_ref !(2,maxcont) + integer,dimension(:),allocatable :: ncont_frag_ref !(mmaxfrag) + integer,dimension(:,:,:),allocatable :: icont_frag_ref !(2,maxcont,mmaxfrag) + integer,dimension(:),allocatable :: isec_ref !(maxres) +!--------------------------------------------------------------------------- +! COMMON.CONTPAR +! common /contpar/ +! real(kind=8),dimension(:,:),allocatable :: sig_comp,chi_comp,& +! chip_comp,sc_cutoff !(ntyp,ntyp) +!--------------------------------------------------------------------------- + end module wham_data diff --git a/source/wham/work_partition.f90 b/source/wham/work_partition.f90 new file mode 100644 index 0000000..a50da8e --- /dev/null +++ b/source/wham/work_partition.f90 @@ -0,0 +1,127 @@ + module work_part +!------------------------------------------------------------------------------ + use io_units + use MPI_data + use wham_data + implicit none +#ifdef MPI +!------------------------------------------------------------------------------ +! +! +!----------------------------------------------------------------------------- + contains +!----------------------------------------------------------------------------- +#ifdef CLUSTER + subroutine work_partition(lprint,ncon_work) +#else + subroutine work_partition(islice,lprint) +#endif +! Split the conformations between processors +! implicit none +! include "DIMENSIONS" +! include "DIMENSIONS.ZSCOPT" +! include "DIMENSIONS.FREE" + include "mpif.h" +! include "COMMON.IOUNITS" +! include "COMMON.MPI" +! include "COMMON.PROT" + integer :: islice,ncon_work + integer :: n,chunk,i,j,ii,remainder +!el integer :: kolor + integer :: key,ierror,errcode + logical :: lprint +! +! Divide conformations between processors; the first and +! the last conformation to handle by ith processor is stored in +! indstart(i) and indend(i), respectively. +! +!el MPI_data + if (.not. allocated(indstart)) allocate(indstart(0:nprocs)) + if (.not. allocated(indend)) allocate(indend(0:nprocs)) + if (.not. allocated(idispl)) allocate(idispl(0:nprocs)) + if (.not. allocated(scount)) allocate(scount(0:nprocs)) +! First try to assign equal number of conformations to each processor. +! +#ifdef CLUSTER + n=ncon_work + write (iout,*) "n=",n," nprocs=",nprocs + nprocs1=nprocs +#else + n=ntot(islice) + write (iout,*) "n=",n +#endif + indstart(0)=1 + chunk = N/nprocs1 + scount(0) = chunk +write(iout,*)"chunk",chunk,scount(0) +flush(iout) +! print *,"i",0," indstart",indstart(0)," scount",& +! scount(0) + do i=1,nprocs1-1 + indstart(i)=chunk+indstart(i-1) + scount(i)=scount(i-1) +! print *,"i",i," indstart",indstart(i)," scount", +! & scount(i) + enddo +! +! Determine how many conformations remained yet unassigned. +! + remainder=N-(indstart(nprocs1-1) & + +scount(nprocs1-1)-1) +! print *,"remainder",remainder +! +! Assign the remainder conformations to consecutive processors, starting +! from the lowest rank; this continues until the list is exhausted. +! + if (remainder .gt. 0) then + do i=1,remainder + scount(i-1) = scount(i-1) + 1 + indstart(i) = indstart(i) + i + enddo + do i=remainder+1,nprocs1-1 + indstart(i) = indstart(i) + remainder + enddo + endif + + indstart(nprocs1)=N+1 + scount(nprocs1)=0 + + do i=0,NProcs1 + indend(i)=indstart(i)+scount(i)-1 + idispl(i)=indstart(i)-1 + enddo + + N=0 + do i=0,Nprocs1-1 + N=N+indend(i)-indstart(i)+1 + enddo + +! print *,"N",n," NTOT",ntot(islice) +#ifdef CLUSTER + if (N.ne.ncon_work) then + write (iout,*) "!!! Checksum error on processor",me,& + n,ncon_work +#else + if (N.ne.ntot(islice)) then + write (iout,*) "!!! Checksum error on processor",me,& + " slice",islice +#endif + call flush(iout) + call MPI_Abort( MPI_COMM_WORLD, Ierror, Errcode ) + endif + + if (lprint) then + write (iout,*) "Partition of work between processors" + do i=0,nprocs1-1 + write (iout,'(a,i5,a,i7,a,i7,a,i7)') & + "Processor",i," indstart",indstart(i),& + " indend",indend(i)," count",scount(i) + enddo + endif + return + end subroutine work_partition +#endif +!---------------------------------------------------------------------------- + end module work_part +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- diff --git a/source/wham/xdrf b/source/wham/xdrf new file mode 120000 index 0000000..aa19d57 --- /dev/null +++ b/source/wham/xdrf @@ -0,0 +1 @@ +../xdrf/ \ No newline at end of file -- 1.7.9.5