--- /dev/null
+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
--- /dev/null
+#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
--- /dev/null
+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
--- /dev/null
+#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
+
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+ 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
--- /dev/null
+ 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
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
--- /dev/null
+!*********************** 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_
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
--- /dev/null
+ 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
--- /dev/null
+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
--- /dev/null
+ 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
--- /dev/null
+#include <stdlib.h>
+#include <math.h>
+#include <stdio.h>
+
+#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
--- /dev/null
+ 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
--- /dev/null
+../xdrf/
\ No newline at end of file
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,&
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'
endif
nft00_c=nft
nft0i=nft
+
!cccccccccccccccccccccccccccccccccccccc
do while (.not. finished)
!cccccccccccccccccccccccccccccccccccccc
+++ /dev/null
- 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
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
!-----------------------------------------------------------------------------
! 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/
! 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;
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'
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'
use MPI_data
use minimm, only:minimize
+! use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
+++ /dev/null
- 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
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'
use control, only: tcpu
use control_data
use energy_data
+! use io_conf, only:cartprint
! include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
! 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
! 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
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
#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
#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),&
#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"
t_enegrad=t_enegrad+tcpu()-tt0
#endif
endif
-write(iout,*) "end init MD"
return
end subroutine init_MD
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
subroutine setup_fricmat
+! use MPI
use energy_data
use control_data, only:time_Bcast
use control, only:tcpu
#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
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
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
+++ /dev/null
- 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
+++ /dev/null
- 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
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)
!-----------------------------------------------------------------------------
nres2=2*nres
time001=0.0d0
-write(iout,*) "jestesmy na poczatku MREMD"
ntwx_cache=0
time00=MPI_WTIME()
time01=time00
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")
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
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),&
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
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)
!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
' 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
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)
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
###################################################################
-#
-# 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"
.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
--- /dev/null
+###################################################################
+#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
--- /dev/null
+###################################################################
+#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
--- /dev/null
+###################################################################
+#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
--- /dev/null
+###################################################################
+#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
--- /dev/null
+###################################################################
+#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
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
enddo
enddo
endif
- deallocate(Gcopy)
+! deallocate(Gcopy)
return
end subroutine setup_MD_matrices
!-----------------------------------------------------------------------------
+++ /dev/null
- 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
+++ /dev/null
- 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
! 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...'
+++ /dev/null
- 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
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
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
!
!-----------------------------------------------------------------------------
contains
-#ifndef WHAM_RUN
+#if .not. defined WHAM_RUN && .not. defined CLUSTER
!-----------------------------------------------------------------------------
! contact.f
!-----------------------------------------------------------------------------
! enddo
enddo
endif
-!elwrite(iout,*) "nharp=", nharp,"nres/3",nres/3
return
end subroutine hairpin
!-----------------------------------------------------------------------------
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)
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)
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)
i,restyp(it1),i1,restyp(it2),i2,econt(i)
enddo
endif
-!elwrite(iout,*) "koniec elecont"
return
end subroutine elecont
!-----------------------------------------------------------------------------
!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
enddo
! finding alpha or 310 helix
-!elwrite(iout,*) "findings helix"
nhelix=0
do i=1,ncont
i1=icont(1,i)
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
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
! & 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)
!-----------------------------------------------------------------------------
subroutine test
+!el use minim
use geometry, only:pinorm
use random, only:ran_number,iran_num
! implicit real*8 (a-h,o-z)
!el#ifdef MPI
subroutine test_n16
+!el use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
subroutine test11
use geometry, only:dist
+!el use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
subroutine test3
use geometry, only:dist
+!el use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
!-----------------------------------------------------------------------------
subroutine test__
+!el use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
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'
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'
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'
subroutine softreg
use geometry, only:dist
+!el use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
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'
!-----------------------------------------------------------------------------
subroutine beta_zip(i1,i2,ieval,ij)
+!el use minim
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
include 'mpif.h'
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'
+++ /dev/null
- 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
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/
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
!-----------------------------------------------------------------------------
!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)
!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
rr=dacos(100.0d0)
#ifdef WINPGI
idumm=proc_proc(rr,i)
-#else
+#elif defined(WHAM_RUN)
call proc_proc(rr,i)
#endif
#endif
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.
!
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
ihist=30
iweight=31
izsc=32
+#endif
+#if defined(WHAM_RUN) || defined(CLUSTER)
!
! setting the mpi variables for WHAM
!
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
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
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
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'
!... 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,&
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
!-----------------------------------------------------------------------------
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)
end subroutine int_partition
#endif
!-----------------------------------------------------------------------------
+#ifndef CLUSTER
subroutine hpb_partition
! implicit real*8 (a-h,o-z)
#endif
return
end subroutine hpb_partition
+#endif
!-----------------------------------------------------------------------------
-! misc.f in module io_common
+! misc.f in module io_base
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
! parmread.F
! 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
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:
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'
return
end function tcpu
!-----------------------------------------------------------------------------
+#ifndef CLUSTER
subroutine dajczas(rntime,hrtime,mintime,sectime)
! include 'COMMON.IOUNITS'
!-----------------------------------------------------------------------------
subroutine print_detailed_timing
+!el use MPI_data
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
endif
return
end subroutine print_detailed_timing
+#endif
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
end module control
+++ /dev/null
- 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
!
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.
!
! 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
.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
! 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
! 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.
! 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.
!
! 6/23/01 Calculate double-torsional energy
!
+!elwrite(iout,*) "in etotal",ipot
if (wtor_d.gt.0) then
call etor_d(etors_d)
else
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
#ifdef TIMING
time_sumene=time_sumene+MPI_Wtime()-time00
#endif
+!el call enerprint(energia)
+!elwrite(iout,*)"finish etotal"
return
end subroutine etotal
!-----------------------------------------------------------------------------
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)
#ifdef MPI
endif
#endif
-!el #undef DUBUG
+! call enerprint(energia)
call flush(iout)
return
end subroutine sum_energy
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
#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
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
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)
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
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!!!!
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
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
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
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) &
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"
!d enddo
!d enddo
return
-!el #undef DUBUG
end subroutine set_matrices
!-----------------------------------------------------------------------------
subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
!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
! 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
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
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)
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)
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,&
#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))
1 continue
enddo
-!el #undef DUBUG
return
end subroutine esc
!-----------------------------------------------------------------------------
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...
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
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
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)
enddo
enddo
else
-write(iout,*) 'Calling CHECK_ECARTIN else.'
!- split gradient check
call zerograd
call etotal_long(energia)
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)
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)
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
!-----------------------------------------------------------------------------
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
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
! 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
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)
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
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
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
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
real(kind=8) :: deps,ssx0,ljx0
!-------END TESTING CODE
+ eij=0.0d0
i=resi
j=resj
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
! 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
!-----------------------------------------------------------------------------
#ifdef WHAM
subroutine read_ssHist
- implicit none
+! implicit none
! Includes
! include 'DIMENSIONS'
! include "DIMENSIONS.FREE"
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))
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))
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)
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))
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))
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))
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)
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
!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
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
! 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
+++ /dev/null
- 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
use energy_data
implicit none
!-----------------------------------------------------------------------------
+! commom.bounds
+! common /bounds/
+!-----------------------------------------------------------------------------
! commom.chain
! common /chain/
! common /rotmat/
! 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.
!
#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
#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
#endif
return
end subroutine int_from_cart1
-#ifndef WHAM_RUN
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
!-----------------------------------------------------------------------------
! check_sc_distr.f
!-----------------------------------------------------------------------------
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
thetnorm=xx
return
end function thetnorm
-#ifndef WHAM_RUN
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
!-----------------------------------------------------------------------------
subroutine var_to_geom_restr(n,xx)
!
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.'
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
!-----------------------------------------------------------------------------
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
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))
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)
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
yyref(i),zzref(i)
enddo
endif
+
return
end subroutine sc_loc_geom
!-----------------------------------------------------------------------------
enddo
return
end subroutine sccenter
-#ifndef WHAM_RUN
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
!-----------------------------------------------------------------------------
subroutine bond_regular
use calc_data
! 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
!-----------------------------------------------------------------------------
!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
! 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"
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
!-----------------------------------------------------------------------------
+++ /dev/null
- 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
endif
#endif
! print *,"Processor",myrank," leaves READRTNS"
+! write(iout,*) "end readrtns"
return
end subroutine readrtns
!-----------------------------------------------------------------------------
!
! Read molecular data.
!
+! use control, only: ilen
use control_data
use geometry_data
use energy_data
! 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
!-----------------------------
!
! 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
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
! 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
#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
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
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
!-----------------------------------------------------------------------------
!
!
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))
enddo
endif
endif
-!write(iout,*) "end read_bridge"
+! write(iout,*) "end read_bridge"
return
end subroutine read_bridge
!-----------------------------------------------------------------------------
! 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)
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
subroutine read_angles(kanal,*)
use geometry_data
+ ! use energy
+ ! use control
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
!-----------------------------------------------------------------------------
subroutine read_dist_constr
use MPI_data
+ ! use control
use geometry, only: dist
use geometry_data
use control_data
use geometry_data, only: c,nres
use energy_data
+ ! use control
use compare_data
use MD_data
! implicit real*8 (a-h,o-z)
! format.
use geometry_data, only: c
use energy_data
+ ! use control
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.CHAIN'
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'
! 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')
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)
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
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
! 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)
!-----------------------------------------------------------------------------
!
!-----------------------------------------------------------------------------
contains
-#ifndef WHAM_RUN
+#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
!-----------------------------------------------------------------------------
! bank.F io_csa
!-----------------------------------------------------------------------------
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
!-----------------------------------------------------------------------------
' in position',i4)
return
end subroutine read_secstr_pred
-#endif
+!#endif
!-----------------------------------------------------------------------------
! parmread.F
!-----------------------------------------------------------------------------
! 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:
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
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),&
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)
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)
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)
enddo
enddo
endif
-
!
! Read electrostatic-interaction parameters
!
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.
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
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
!-----------------------------------------------------------------------------
! 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
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
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
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)
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
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))
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)
! 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
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
!-----------------------------------------------------------------------------
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)
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) &
+++ /dev/null
- 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
! call enerprint(energia)
10 continue
enddo ! i
- deallocate(x,g)
+! deallocate(x,g)
return
end subroutine map
!-----------------------------------------------------------------------------
+++ /dev/null
- 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
use io_units
use MD_data, only:D_ban,IP
use geometry_data
+! use prng ! prng.f90 or prng_32.f90
implicit none
!
!-----------------------------------------------------------------------------
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
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
!-----------------------------------------------------------------------------
!
!
! *** 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) &
! *** carry out humsl (unconstrained minimization) iterations, using
! *** hessian matrix provided by the caller.
!
+!el use control
use control, only:stopx
! *** parameter declarations ***
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
use MPI_data
use energy, only: cartgrad,zerograd,etotal
+! use MD_data
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
#ifdef MPI
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---------------------
!
use calc_data
use energy, only: sc_grad
+! use control, only:stopx
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
! include 'COMMON.GEO'
! *** 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)
+++ /dev/null
- 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
!-----------------------------------------------------------------------------
subroutine muca_update(energy)
- ! use remd
- ! use MPI
use control_data
! implicit real*8 (a-h,o-z)
! include 'DIMENSIONS'
+++ /dev/null
- 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
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
!-----------------------------------------------------------------------------
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
!-----------------------------------------------------------------------------
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
!-----------------------------------------------------------------------------
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
!-----------------------------------------------------------------------------
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)
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
!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
use prng ! prng.f90 or prng_32.f90
use math
implicit none
+! public :: rndv
!
!-----------------------------------------------------------------------------
contains
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
! 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
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)
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
!-----------------------------------------------------------------------------
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)
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
use geometry, only:chainbuild
use MDyn
use io_units !include 'COMMON.IOUNITS'
+! use io_common
implicit none
! include 'DIMENSIONS'
#ifdef MPI
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
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"
endif
call etotal(energy_)
+!elwrite(iout,*)"after etotal in exec_eev"
#ifdef MPI
time_ene=MPI_Wtime()-time00
#endif
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
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
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
!-----------------------------------------------------------------------------
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
end subroutine exec_checkgrad
!-----------------------------------------------------------------------------
subroutine exec_map
+! use map_data
use map_
use io_config, only:map_read
implicit none
use io_units !include 'COMMON.IOUNITS'
use CSA
+
implicit none
#ifdef MPI
include "mpif.h"
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,&
--- /dev/null
+../xdrf
\ No newline at end of file
--- /dev/null
+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
+
--- /dev/null
+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
+
--- /dev/null
+! 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
--- /dev/null
+#include <stdio.h>
+#include <sys/utsname.h>
+#include <sys/types.h>
+#include <time.h>
+#include <string.h>
+
+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");
+}
--- /dev/null
+ 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
+
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
--- /dev/null
+ 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
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+
--- /dev/null
+#include <stdlib.h>
+#include <math.h>
+#include <stdio.h>
+
+#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
--- /dev/null
+ 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
+
--- /dev/null
+ 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
--- /dev/null
+ 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
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
--- /dev/null
+ 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
+
--- /dev/null
+ 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
--- /dev/null
+ 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
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
--- /dev/null
+../xdrf/
\ No newline at end of file
projects / unres4.git / commitdiff