From 60a3f9d89e537f69c6c19a8240c6c8dc6b2a1db0 Mon Sep 17 00:00:00 2001 From: Felipe Pineda Date: Thu, 16 Apr 2015 09:46:48 +0200 Subject: [PATCH] WHAM and CLUSTER with HM restraints by AL and FP --- source/cluster/wham/src/CMakeLists.txt | 116 +- source/cluster/wham/src/COMMON.CHAIN | 7 +- source/cluster/wham/src/COMMON.CONTROL | 12 +- source/cluster/wham/src/COMMON.DERIV | 6 +- source/cluster/wham/src/COMMON.DFA | 101 + source/cluster/wham/src/COMMON.FFIELD | 10 +- source/cluster/wham/src/COMMON.HOMRESTR | 39 + source/cluster/wham/src/COMMON.SETUP | 21 + source/cluster/wham/src/COMMON.VAR | 9 +- source/cluster/wham/src/DIMENSIONS | 5 +- source/cluster/wham/src/Makefile-MPI | 34 + source/cluster/wham/src/Makefile-MPI-INTEL-old | 33 + source/cluster/wham/src/Makefile-MPI-opteron | 39 + source/cluster/wham/src/Makefile-MPI-opteron-old | 39 + source/cluster/wham/src/Makefile-MPI-w-opteron | 39 + source/cluster/wham/src/Makefile-MPICH-gfortran | 66 - source/cluster/wham/src/Makefile-MPICH-ifort | 53 +- source/cluster/wham/src/dfa.F | 3455 ++++++++++++++++++++ source/cluster/wham/src/energy_p_new.F | 680 +++- source/cluster/wham/src/include_unres/COMMON.DERIV | 6 +- .../cluster/wham/src/include_unres/COMMON.FFIELD | 2 + source/cluster/wham/src/include_unres/COMMON.FRAG | 3 +- source/cluster/wham/src/include_unres/COMMON.MD | 77 - source/cluster/wham/src/include_unres/COMMON.SETUP | 21 - source/cluster/wham/src/initialize_p.F | 52 +- source/cluster/wham/src/int_from_cart1.F | 63 + source/cluster/wham/src/int_from_cart1.f | 63 - source/cluster/wham/src/main_clust.F | 2 +- source/cluster/wham/src/probabl.F | 31 +- source/cluster/wham/src/read_coords.F | 2 - source/cluster/wham/src/readpdb.F | 510 +++ source/cluster/wham/src/readpdb.f | 183 -- source/cluster/wham/src/readrtns.F | 443 ++- source/cluster/wham/src/sizesclu.dat | 2 +- source/unres/src_MD/cinfo.f | 6 +- source/unres/src_MD/energy_p_new_barrier.F | 2 + source/unres/src_MD/initialize_p.F | 1 + source/wham/src/CMakeLists.txt | 17 +- source/wham/src/COMMON.CHAIN | 7 +- source/wham/src/COMMON.CONTROL | 12 +- source/wham/src/COMMON.DFA | 101 + source/wham/src/COMMON.DISTFIT | 14 + source/wham/src/COMMON.HOMRESTR | 39 + source/wham/src/COMMON.VAR | 23 +- source/wham/src/DIMENSIONS | 5 +- source/wham/src/DIMENSIONS.ZSCOPT | 2 +- source/wham/src/Makefile-pgi | 74 + source/wham/src/Makefile1_jump | 60 + source/wham/src/Makefile_0 | 82 + source/wham/src/Makefile_MPICH_ifort | 19 +- source/wham/src/Makefile_MPICH_pgi | 97 - source/wham/src/Makefile_jubl | 95 + source/wham/src/Makefile_jump | 69 + source/wham/src/Makefile_matrix | 67 + source/wham/src/Makefile_matrix_PGI | 76 + source/wham/src/Makefile_matrix_PGI-SCT-oldparm | 76 + source/wham/src/Makefile_matrix_PGI-SCTF-oldparm | 76 + source/wham/src/Makefile_matrix_PGI-oldparm | 76 + source/wham/src/chainbuild.f | 258 -- source/wham/src/dfa.F | 3455 ++++++++++++++++++++ source/wham/src/enecalc1.F | 18 +- source/wham/src/energy_p_new.F | 666 +++- source/wham/src/include_unres/COMMON.DERIV | 6 +- source/wham/src/include_unres/COMMON.FFIELD | 2 + source/wham/src/include_unres/COMMON.SCCOR | 18 +- source/wham/src/include_unres/COMMON.VAR | 21 - source/wham/src/initialize_p.F | 62 +- source/wham/src/make_ensemble1.F | 7 +- source/wham/src/molread_zs.F | 459 +++ source/wham/src/parmread.F | 6 + source/wham/src/promienie.f | 1 + source/wham/src/readpdb.F | 513 +++ source/wham/src/readpdb.f | 219 -- source/wham/src/readrtns.F | 3 + source/wham/src/wham_calc1.F | 43 +- source/wham/src/xdrf | 1 - 76 files changed, 11880 insertions(+), 1198 deletions(-) create mode 100644 source/cluster/wham/src/COMMON.DFA create mode 100644 source/cluster/wham/src/COMMON.HOMRESTR create mode 100644 source/cluster/wham/src/COMMON.SETUP create mode 100644 source/cluster/wham/src/Makefile-MPI create mode 100644 source/cluster/wham/src/Makefile-MPI-INTEL-old create mode 100644 source/cluster/wham/src/Makefile-MPI-opteron create mode 100644 source/cluster/wham/src/Makefile-MPI-opteron-old create mode 100644 source/cluster/wham/src/Makefile-MPI-w-opteron delete mode 100644 source/cluster/wham/src/Makefile-MPICH-gfortran create mode 100644 source/cluster/wham/src/dfa.F delete mode 100644 source/cluster/wham/src/include_unres/COMMON.MD delete mode 100644 source/cluster/wham/src/include_unres/COMMON.SETUP create mode 100644 source/cluster/wham/src/int_from_cart1.F delete mode 100644 source/cluster/wham/src/int_from_cart1.f create mode 100644 source/cluster/wham/src/readpdb.F delete mode 100644 source/cluster/wham/src/readpdb.f create mode 100644 source/wham/src/COMMON.DFA create mode 100644 source/wham/src/COMMON.DISTFIT create mode 100644 source/wham/src/COMMON.HOMRESTR create mode 100644 source/wham/src/Makefile-pgi create mode 100644 source/wham/src/Makefile1_jump create mode 100644 source/wham/src/Makefile_0 delete mode 100644 source/wham/src/Makefile_MPICH_pgi create mode 100644 source/wham/src/Makefile_jubl create mode 100644 source/wham/src/Makefile_jump create mode 100644 source/wham/src/Makefile_matrix create mode 100644 source/wham/src/Makefile_matrix_PGI create mode 100644 source/wham/src/Makefile_matrix_PGI-SCT-oldparm create mode 100644 source/wham/src/Makefile_matrix_PGI-SCTF-oldparm create mode 100644 source/wham/src/Makefile_matrix_PGI-oldparm delete mode 100644 source/wham/src/chainbuild.f create mode 100644 source/wham/src/dfa.F delete mode 100644 source/wham/src/include_unres/COMMON.VAR create mode 100644 source/wham/src/readpdb.F delete mode 100644 source/wham/src/readpdb.f delete mode 120000 source/wham/src/xdrf diff --git a/source/cluster/wham/src/CMakeLists.txt b/source/cluster/wham/src/CMakeLists.txt index 2436260..760269e 100644 --- a/source/cluster/wham/src/CMakeLists.txt +++ b/source/cluster/wham/src/CMakeLists.txt @@ -28,7 +28,6 @@ set(UNRES_CLUSTER_WHAM_SRC0 noyes.f parmread.F pinorm.f - printmat.f probabl.F read_coords.F readpdb.f @@ -66,15 +65,11 @@ if (Fortran_COMPILER_NAME STREQUAL "ifort") set(FFLAGS0 "-ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") set(FFLAGS0 "-std=legacy -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) -else () - set(FFLAGS0 "-I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) endif (Fortran_COMPILER_NAME STREQUAL "ifort") -#========================================= # Add MPI compiler flags -#========================================= if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_CLUSTER_WHAM_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -138,35 +133,132 @@ set_property(SOURCE ${UNRES_CLUSTER_WHAM_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${ #======================================== # Setting binary name #======================================== -set(UNRES_CLUSTER_WHAM_BIN "cluster_wham_${Fortran_COMPILER_NAME}.exe") +set(UNRES_CLUSTER_WHAM_BIN "unres_clustMD.exe") + +#========================================= +# cinfo.f stupid workaround for cmake +# - shame on me ]:) +#========================================= +#set_property(SOURCE compinfo.c PROPERTY CMAKE_C_FLAGS "-c" ) +#add_executable(compinfo-wham-m compinfo.c) +#set_target_properties(compinfo-wham-m PROPERTIES OUTPUT_NAME compinfo) + +#set(UNRES_CINFO_DIR "${CMAKE_CURRENT_BINARY_DIR}" ) +#add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f +# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/cinfo.f ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f +# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/COMMON.IOUNITS ${CMAKE_CURRENT_BINARY_DIR}/COMMON.IOUNITS +# COMMAND ${CMAKE_CURRENT_BINARY_DIR}/compinfo | true +# DEPENDS compinfo-wham-m ) +#set_property(SOURCE ${UNRES_CINFO_DIR}/cinfo.f PROPERTY COMPILE_FLAGS ${FFLAGS0} ) set_property(SOURCE proc_proc.c PROPERTY COMPILE_DEFINITIONS "LINUX -DPGI" ) + + #========================================= # Set full unres CLUSTER sources #========================================= set(UNRES_CLUSTER_WHAM_SRCS ${UNRES_CLUSTER_WHAM_SRC0} proc_proc.c) + + #========================================= # Build the binary #========================================= add_executable(UNRES_CLUSTER_WHAM_BIN ${UNRES_CLUSTER_WHAM_SRCS} ) set_target_properties(UNRES_CLUSTER_WHAM_BIN PROPERTIES OUTPUT_NAME ${UNRES_CLUSTER_WHAM_BIN}) -set_property(TARGET UNRES_CLUSTER_WHAM_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #========================================= # Link libraries #========================================= -# link MPI libraries +# link MPI library (libmpich.a) if(UNRES_WITH_MPI) - target_link_libraries( UNRES_CLUSTER_WHAM_BIN ${MPI_Fortran_LIBRARIES} ) + target_link_libraries( UNRES_CLUSTER_WHAM_BIN ${MPIF_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a target_link_libraries( UNRES_CLUSTER_WHAM_BIN xdrf ) #========================================= -# Install Path +# TESTS +#========================================= + +#-- Copy all the data files from the test directory into the source directory +#SET(UNRES_TEST_FILES +# ala10.inp +# ) + +#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) +# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") +# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") +# ADD_CUSTOM_COMMAND ( +# TARGET ${UNRES_BIN} +# POST_BUILD +# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} +# ) +#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) + +#========================================= +# Generate data test files +#========================================= +# test_single_ala.sh +#========================================= + +#FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh +#"#!/bin/sh +#export POT=GB +#export PREFIX=ala10 +#----------------------------------------------------------------------------- +#UNRES_BIN=./${UNRES_BIN} +#----------------------------------------------------------------------------- +#DD=${CMAKE_SOURCE_DIR}/PARAM +#export BONDPAR=$DD/bond.parm +#export THETPAR=$DD/thetaml.5parm +#export ROTPAR=$DD/scgauss.parm +#export TORPAR=$DD/torsion_631Gdp.parm +#export TORDPAR=$DD/torsion_double_631Gdp.parm +#export ELEPAR=$DD/electr_631Gdp.parm +#export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k +#export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 +#export SCPPAR=$DD/scp.parm +#export SCCORPAR=$DD/rotcorr_AM1.parm +#export PATTERN=$DD/patterns.cart +#----------------------------------------------------------------------------- +#$UNRES_BIN +#") + +#========================================= +# ala10.inp #========================================= -install(TARGETS UNRES_CLUSTER_WHAM_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}) +#file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp +#"ala10 unblocked +#SEED=-1111333 MD ONE_LETTER rescale_mode=2 PDBOUT +#nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & +#reset_moment=1000 reset_vel=1000 MDPDB +#WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & +#WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & +#WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & +#WVDWPP=0.11371 WHPB=1.00000 & +#CUTOFF=7.00000 WCORR4=0.00000 +#12 +#XAAAAAAAAAAX +# 0 +# 0 +# 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 +# 90.0000 90.0000 +# 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 +# 180.0000 +# 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 +# 110.0000 110.0000 +# -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 +# -120.0000 -120.0000 +#") + + +# Add tests + +#if(NOT UNRES_WITH_MPI) + +# add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) +#endif(NOT UNRES_WITH_MPI) diff --git a/source/cluster/wham/src/COMMON.CHAIN b/source/cluster/wham/src/COMMON.CHAIN index aefab5c..efdab56 100644 --- a/source/cluster/wham/src/COMMON.CHAIN +++ b/source/cluster/wham/src/COMMON.CHAIN @@ -1,8 +1,9 @@ integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq - double precision c,cref,dc,xloc,xrot,dc_norm,t,r,prod,rt + double precision c,cref,crefjlee,dc,xloc,xrot,dc_norm,t,r,prod,rt + common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), & xrot(3,maxres),dc_norm(3,maxres2),nres,nres0 common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),nsup,nstart_sup,nstart_seq, - & nend_sup + common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2), + & nsup,nstart_sup,nstart_seq,nend_sup diff --git a/source/cluster/wham/src/COMMON.CONTROL b/source/cluster/wham/src/COMMON.CONTROL index 8c9e317..7619565 100644 --- a/source/cluster/wham/src/COMMON.CONTROL +++ b/source/cluster/wham/src/COMMON.CONTROL @@ -1,9 +1,15 @@ double precision betaT - integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,constr_dist + integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,constr_dist, + & constr_homology,homol_nset,iset + real*8 waga_homology + real*8 waga_dist, waga_angle,waga_theta, waga_d, dist_cut logical refstr,pdbref,punch_dist,print_dist,caonly,lside, & lprint_cart,lprint_int,from_cart,efree,from_bx,from_cx, - & with_dihed_constr + & with_dihed_constr,out1file common /cntrl/ betaT,iscode,indpdb,refstr,pdbref,outpdb,outmol2, & punch_dist,print_dist,caonly,lside,lprint_cart,lprint_int, & from_cart,from_bx,from_cx,efree,iopt,nstart,nend,constr_dist, - & with_dihed_constr + & with_dihed_constr, constr_homology,homol_nset,out1file + common /cntrlr/ waga_homology(1), + & waga_dist, waga_angle, waga_theta, waga_d, dist_cut,iset + diff --git a/source/cluster/wham/src/COMMON.DERIV b/source/cluster/wham/src/COMMON.DERIV index 79f8630..596a365 100644 --- a/source/cluster/wham/src/COMMON.DERIV +++ b/source/cluster/wham/src/COMMON.DERIV @@ -3,7 +3,7 @@ & gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn, & gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc, & g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc, - & gscloc,gsclocx + & gscloc,gsclocx,gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), @@ -19,7 +19,9 @@ & gel_loc_turn6(maxvar),gcorr_loc(maxvar), & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), & gsccorx(3,maxres),gsccor_loc(maxres), - & gscloc(3,maxres),gsclocx(3,maxres),nfl,icg,calc_grad + & gscloc(3,maxres),gsclocx(3,maxres), + & gdfad(3,maxres),gdfat(3,maxres),gdfan(3,maxres),gdfab(3,maxres), + & nfl,icg,calc_grad double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), diff --git a/source/cluster/wham/src/COMMON.DFA b/source/cluster/wham/src/COMMON.DFA new file mode 100644 index 0000000..c6add4f --- /dev/null +++ b/source/cluster/wham/src/COMMON.DFA @@ -0,0 +1,101 @@ +C ======= +C COMMON.DFA +C ======= +C 2010/12/20 By Juyong Lee +C +c parameter +C [ 8 * ( Nres - 8 ) ] distance restraints +C [ 2 * ( Nres - 8 ) ] angle restraints +C [ Nres ] neighbor restraints +C Total : ~ 11 * Nres restraints +C +C + INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN + PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(MAXN=4) + real*8 wwdist,wwangle,wwnei + parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) + +C IDFAMAX - maximum number of DFA restraint including distance, angle and +C number of neighbors ( Max of assign statement ) +C IDFAMX2 - maximum number of atoms which are targets of restraints +C IDFACMD - maximum number of 'DFA' command call +C IDMAXMIN - Maximum number of minima of dist, angle and neighbor info. from fragments +C MAXN - Maximum Number of shell, currently 4 +C MAXRES - Maximum number of CAs + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc +C INTEGER +C DFANUM - Number of ALL DFA restrants +c IDFA[DIS, PHI, THE, NEI] - NUMBER of restraints +c IDISNUM - number of minima for a distance restraint +c IPHINUM - number of minima for a phi angle restraint +c ITHENUM - number of minima for a theta angle restraint +c INEINUM - number of minima for a number of neighbors restraint + +c IDISLIS - atom number of two atoms for distance restraint +c IPHILIS - atom numbers of four atoms for angle restraint +c ITHELIS - atom numbers of four atoms for angle restraint +c INEILIS - atom number of center of neighbor calculation +c JNEILIS - atom number of target of neighboring calculation +c JNEINUM - number of target atoms of neighboring term +C KSHELL - SHELL number + +C ishiftca - index shift for CA atoms in UNRES (1 if the 1st aa != GLY) +C ilastca - index of the last CA atom in UNRES (nres-1 if last aa != GLY) + +C old only for CHARMM +C STOAGDF - Store assign information ( How many assign within one command ) +C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei + + INTEGER IDFADIS,IDFAPHI,IDFATHE,IDFANEI, + & IDISLIS,IPHILIS,ITHELIS,INEILIS, + & IDISNUM,IPHINUM,ITHENUM,INEINUM, + & FNEI,DFACMD, DFANUM, + & NCA,ICAIDX, + & STOAGDF, NMAP, IDFACAT, KDISNUM, KSHELL + & ishiftca,ilastca + COMMON /IDFA/ DFACMD, DFANUM, + & IDFADIS, IDFAPHI, IDFANEI, IDFATHE, + & IDISNUM(IDFAMAX), IPHINUM(IDFAMAX), + & ITHENUM(IDFAMAX), INEINUM(IDFAMAX), + & FNEI(IDFAMAX,IDMAXMIN), IDISLIS(2,IDFAMAX), + & IPHILIS(5,IDFAMAX), ITHELIS(5,IDFAMAX), + & INEILIS(IDFAMAX), + & KSHELL(IDFAMAX), + & IDFACAT(IDFACMD), + & KDISNUM(IDFAMAX), + & NCA, ICAIDX(MAXRES) + COMMON /IDFA2/ ishiftca,ilastca + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C +C REAL VARIABLES +C +c SCC[DIST, PHI, THE] - weight of each calculations +c FDIST - distance minima +C FPHI - phi minima +c FTHE - theta minima +C DFAEXP : calculate expential function in advance +C + REAL*8 SCCDIST, SCCPHI, SCCTHE, SCCNEI, FDIST, FPHI1, FPHI2, + & FTHE1, FTHE2, + & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, + & WSHET, EDFABET, + & CK, SCK, S1, S2 +c & ,DFAEXP + + COMMON /RDFA/ SCCDIST(IDFAMAX,IDMAXMIN),FDIST(IDFAMAX,IDMAXMIN), + & SCCPHI(IDFAMAX,IDMAXMIN), SCCTHE(IDFAMAX,IDMAXMIN), + & SCCNEI(IDFAMAX,IDMAXMIN), + & FPHI1(IDFAMAX,IDMAXMIN), FPHI2(IDFAMAX,IDMAXMIN), + & FTHE1(IDFAMAX,IDMAXMIN), FTHE2(IDFAMAX,IDMAXMIN), + & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, + & WSHET(MAXRES,MAXRES), EDFABET, + & CK(4),SCK(4),S1(4),S2(4) +c & ,DFAEXP(15001), + + DATA CK/1.0D0,1.58740105197D0,2.08008382305D0,2.51984209979D0/ + DATA SCK/1.0D0,1.25992104989D0,1.44224957031D0,1.58740105197D0/ + DATA S1/3.75D0,5.75D0,7.75D0,9.75D0/ + DATA S2/4.25D0,6.25D0,8.25D0,10.25D0/ diff --git a/source/cluster/wham/src/COMMON.FFIELD b/source/cluster/wham/src/COMMON.FFIELD index ccafd30..fdc40cb 100644 --- a/source/cluster/wham/src/COMMON.FFIELD +++ b/source/cluster/wham/src/COMMON.FFIELD @@ -6,13 +6,15 @@ C----------------------------------------------------------------------- double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,wturn6, & wvdwpp,wbond,weights,scal14,scalscp,cutoff_corr,delt_corr, - & r0_corr + & r0_corr,wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta integer ipot,n_ene_comp,rescale_mode common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,wturn6, - & wvdwpp,wbond,weights(max_ene),scalscp, - & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, - & rescale_mode + & wvdwpp,wbond, + & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, + & weights(max_ene),scalscp, + & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, + & rescale_mode common /potentials/ potname(5) character*3 potname C----------------------------------------------------------------------- diff --git a/source/cluster/wham/src/COMMON.HOMRESTR b/source/cluster/wham/src/COMMON.HOMRESTR new file mode 100644 index 0000000..5c23caf --- /dev/null +++ b/source/cluster/wham/src/COMMON.HOMRESTR @@ -0,0 +1,39 @@ + real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), + & dih(max_template,maxres),sigma_dih(max_template,maxres), + & sigma_odlir(max_template,maxdim) +c +c Specification of new variables used in subroutine e_modeller +c modified by FP (Nov.,2014) + real*8 xxtpl(max_template,maxres),yytpl(max_template,maxres), + & zztpl(max_template,maxres),thetatpl(max_template,maxres), + & sigma_theta(max_template,maxres), + & sigma_d(max_template,maxres) +c + + integer ires_homo(maxdim),jres_homo(maxdim) + + double precision + & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, + & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), + & dutheta(maxres),dugamma(maxres), + & duscdiff(3,maxres), + & duscdiffx(3,maxres), + & uconst_back + integer lim_odl,lim_dih,link_start_homo,link_end_homo, + & idihconstr_start_homo,idihconstr_end_homo +c +c FP (30/10/2014) +c +c integer ithetaconstr_start_homo,ithetaconstr_end_homo +c + integer nresn,nyosh,nnos + common /back_constr/ uconst_back,uscdiff, + & dutheta,dugamma,duscdiff,duscdiffx + common /homrestr/ odl,dih,sigma_dih,sigma_odl, + & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo, + & link_end_homo,idihconstr_start_homo,idihconstr_end_homo, +c +c FP (30/10/2014,04/03/2015) +c + & xxtpl,yytpl,zztpl,thetatpl,sigma_theta,sigma_d,sigma_odlir +c diff --git a/source/cluster/wham/src/COMMON.SETUP b/source/cluster/wham/src/COMMON.SETUP new file mode 100644 index 0000000..5039116 --- /dev/null +++ b/source/cluster/wham/src/COMMON.SETUP @@ -0,0 +1,21 @@ + integer king,idint,idreal,idchar,is_done + parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1) + integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor, + & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM, + & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1), + & kolor1,key1,nfgtasks1,MyRank, + & max_gs_size + logical yourjob, finished, cgdone + common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs, + & nfgtasks,nfgtasks1, + & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM, + & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp + integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, + & MPI_THET,MPI_GAM, + & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1), + & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1), + & MPI_PRECOMP23(0:1) + common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, + & MPI_THET,MPI_GAM, + & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12, + & MPI_PRECOMP22,MPI_PRECOMP23 diff --git a/source/cluster/wham/src/COMMON.VAR b/source/cluster/wham/src/COMMON.VAR index 326d6ec..c7b331b 100644 --- a/source/cluster/wham/src/COMMON.VAR +++ b/source/cluster/wham/src/COMMON.VAR @@ -2,15 +2,16 @@ C Store the geometric variables in the following COMMON block. integer ntheta,nphi,nside,nvar,ialph,ivar double precision theta,phi,alph,omeg,vbld,vbld_ref, & theta_ref,phi_ref,alph_ref,omeg_ref, + & thetaref,phiref,xxref,yyref,zzref, & costtab,sinttab,cost2tab,sint2tab,tauangle,omicron, & xxtab,yytab,zztab common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & vbld(2*maxres), + & omicron(2,maxres),tauangle(3,maxres), + & vbld(2*maxres),thetaref(maxres),phiref(maxres), & costtab(maxres), sinttab(maxres), cost2tab(maxres), & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar, - & omicron(2,maxres),tauangle(3,maxres) + & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), + & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar C Angles from experimental structure common /varref/ vbld_ref(maxres), & theta_ref(maxres),phi_ref(maxres), diff --git a/source/cluster/wham/src/DIMENSIONS b/source/cluster/wham/src/DIMENSIONS index 806387c..35ddecd 100644 --- a/source/cluster/wham/src/DIMENSIONS +++ b/source/cluster/wham/src/DIMENSIONS @@ -55,7 +55,7 @@ C Max. number of dihedral angle constraints parameter (maxdih_constr=maxres) C Max. number of energy components integer max_ene - parameter (max_ene=20) + parameter (max_ene=27) C Max. number of temperatures integer maxt parameter (maxT=5) @@ -65,3 +65,6 @@ C Maximum number of SC local term fitting function coefficiants C Maximum number of terms in SC bond-stretching potential integer maxbondterm parameter (maxbondterm=3) +C Maximum number of templates in homology-modeling restraints + integer max_template + parameter(max_template=19) diff --git a/source/cluster/wham/src/Makefile-MPI b/source/cluster/wham/src/Makefile-MPI new file mode 100644 index 0000000..36a0387 --- /dev/null +++ b/source/cluster/wham/src/Makefile-MPI @@ -0,0 +1,34 @@ +BIN = /users/adam/ZSCOREZ/bin +CC = cc +FC = mpif90 +PGI=/opt/pgi +OPT = -fast -pc 64 -tp p6 -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 +#FFLAGS = ${OPT} -c -I. -I../src_MD_T/include_unres -I../src_MD +FFLAGS = ${OPT} -c -I. -I../src_MD_T/include_unres -I../src_MD +LIBS = -L../../MEY_MD/src_Tc/xdrf -lxdrf +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ + setup_var.o + +unres_clust: $(objects) + $(FC) ${OPT} ${objects} ${LIBS} -m -Bstatic -o ${BIN}/unres_clustMD_MPI-nopteron + +clean: + /bin/rm *.o + +move: + mv *.o ${OBJ} diff --git a/source/cluster/wham/src/Makefile-MPI-INTEL-old b/source/cluster/wham/src/Makefile-MPI-INTEL-old new file mode 100644 index 0000000..3402c53 --- /dev/null +++ b/source/cluster/wham/src/Makefile-MPI-INTEL-old @@ -0,0 +1,33 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +BIN=/users/adam/ZSCOREZ/bin +FC = ifort +OPT = -O3 -ip -w +OPT = -CB -g +FFLAGS = ${OPT} -c -I. -I../src_MD_T-sccor/include_unres -I../src_MD_T-sccor -I/users/adam/MEY_MD/src_Tc-czarek -I$(INSTALL_DIR)/include +CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMP -DMPI +LIBS = -L$(INSTALL_DIR)/lib -lmpich ../srcWHAM-Tsccor/xdrf/libxdrf.a -g -d2 -CA -CB + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ + setup_var.o read_ref_str.o + +unres_clust: $(objects) + $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPI-oldparm + +clean: + /bin/rm *.o + +move: + mv *.o ${OBJ} diff --git a/source/cluster/wham/src/Makefile-MPI-opteron b/source/cluster/wham/src/Makefile-MPI-opteron new file mode 100644 index 0000000..657211b --- /dev/null +++ b/source/cluster/wham/src/Makefile-MPI-opteron @@ -0,0 +1,39 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh +BIN=/users/adam/ZSCOREZ/bin +FC= pgf90 +OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -C -g -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -pc 64 -tp amd64 +OPT = -C -g +FFLAGS = ${OPT} -c -I. -I../src_MD_T-sccor/include_unres -I../src_MD_T-sccor -I/users/adam/MEY_MD/src_Tc-czarek -I$(INSTALL_DIR)/include +FFLAGS1 = ${FFLAGS} +FFLAGS2 = ${FFLAGS} +#FFLAGS1 = ${OPT} -g -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +#FFLAGS2 = ${OPT1} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich -L../srcWHAM-Tsccor/xdrf -lxdrf + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ + setup_var.o read_ref_str.o + +unres_clust: $(objects) + $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPI-new + +clean: + /bin/rm *.o + +move: + mv *.o ${OBJ} diff --git a/source/cluster/wham/src/Makefile-MPI-opteron-old b/source/cluster/wham/src/Makefile-MPI-opteron-old new file mode 100644 index 0000000..31da78e --- /dev/null +++ b/source/cluster/wham/src/Makefile-MPI-opteron-old @@ -0,0 +1,39 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh +BIN=/users/adam/ZSCOREZ/bin +FC= pgf90 +OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -C -g -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -pc 64 -tp amd64 +OPT = -C -g +FFLAGS = ${OPT} -c -I. -I../src_MD_T-sccor/include_unres -I../src_MD_T-sccor -I/users/adam/MEY_MD/src_Tc-czarek -I$(INSTALL_DIR)/include +FFLAGS1 = ${FFLAGS} +FFLAGS2 = ${FFLAGS} +#FFLAGS1 = ${OPT} -g -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +#FFLAGS2 = ${OPT1} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMP -DMPI +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich -L../srcWHAM-Tsccor/xdrf -lxdrf + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ + setup_var.o read_ref_str.o + +unres_clust: $(objects) + $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPI-oldparm + +clean: + /bin/rm *.o + +move: + mv *.o ${OBJ} diff --git a/source/cluster/wham/src/Makefile-MPI-w-opteron b/source/cluster/wham/src/Makefile-MPI-w-opteron new file mode 100644 index 0000000..0aa2066 --- /dev/null +++ b/source/cluster/wham/src/Makefile-MPI-w-opteron @@ -0,0 +1,39 @@ +INSTALL_DIR = /usr/local/mpich-1.2.5.2_pgi64-6.0-4_ssh +BIN=/users/adam/ZSCOREZ/bin +FC= pgf90 +OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -C -g -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -pc 64 -tp amd64 +#OPT = -C -g +FFLAGS = ${OPT} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +FFLAGS1 = ${FFLAGS} +FFLAGS2 = ${FFLAGS} +#FFLAGS1 = ${OPT} -g -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +#FFLAGS2 = ${OPT1} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include +CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich + +.c.o: + cc -c -DLINUX -DPGI $*.c + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F + +objects = main_clust_w.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ + matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ + geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hcw.o \ + track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ + int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ + setup_var.o + +unres_clust: $(objects) + $(FC) ${OPT} ${objects} ${LIBS} -m -o ${BIN}/unres_clustMD_w_MPI + +clean: + /bin/rm *.o + +move: + mv *.o ${OBJ} diff --git a/source/cluster/wham/src/Makefile-MPICH-gfortran b/source/cluster/wham/src/Makefile-MPICH-gfortran deleted file mode 100644 index 65249b6..0000000 --- a/source/cluster/wham/src/Makefile-MPICH-gfortran +++ /dev/null @@ -1,66 +0,0 @@ -################################################################## -INSTALL_DIR = /users/software/mpich2-1.0.7 - -FC= gfortran - -OPT = -O - -FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include - -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpthread xdrf/libxdrf.a - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o ssMD.o - -all: no_option - @echo "Specify force field: GAB, 4P or E0LL2Y" - -no_option: - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DG77 -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../../bin/cluster/unres_clustMD_gfort_MPICH_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - $(FC) ${OPT} ${object} ${LIBS} -o ${BIN} - -4P: CPPFLAGS = -DLINUX -DG77 -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -4P: BIN = ../../../../bin/cluster/unres_clustMD_gfort_MPICH_4P.exe -4P: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - $(FC) ${OPT} ${object} ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DLINUX -DG77 -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../../bin/cluster/unres_clustMD_gfort_MPICH_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - $(FC) ${OPT} ${object} ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - - diff --git a/source/cluster/wham/src/Makefile-MPICH-ifort b/source/cluster/wham/src/Makefile-MPICH-ifort index c688216..ef70085 100644 --- a/source/cluster/wham/src/Makefile-MPICH-ifort +++ b/source/cluster/wham/src/Makefile-MPICH-ifort @@ -1,10 +1,12 @@ INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +BIN=../../../../bin/cluster FC = ifort OPT = -O3 -ip -w #OPT = -CB -g 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 +CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI -DCLUST +#LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB +LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .c.o: cc -c -DLINUX -DPGI $*.c @@ -15,48 +17,33 @@ LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB .F.o: ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F -object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ +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 ssMD.o + setup_var.o read_ref_str.o gnmr1.o ssMD.o dfa.o -all: no_option - @echo "Specify force field: GAB, 4P or E0LL2Y" - -no_option: - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../../bin/cluster/unres_clustMD_ifort_MPICH_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - $(FC) ${OPT} ${object} ${LIBS} -o ${BIN} - -4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -4P: BIN = ../../../../bin/cluster/unres_clustMD_ifort_MPICH_4P.exe -4P: ${object} xdrf/libxdrf.a +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DCLUST \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: $(objects) xdrf/libxdrf.a cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - $(FC) ${OPT} ${object} ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ - -DCLUST -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../../bin/cluster/unres_clustMD_ifort_MPICH_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} cinfo.o ${LIBS} -o ${BIN}/unres_clustMD_MPICH-restr-DFA-GAB.exe + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DCLUST \ + -DSPLITELE -DLANG0 +E0LL2Y: $(objects) xdrf/libxdrf.a cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - $(FC) ${OPT} ${object} ${LIBS} -o ${BIN} + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} cinfo.o ${LIBS} -o ${BIN}/unres_clustMD_MPICH-restr-DFA-E0LL2Y.exe xdrf/libxdrf.a: cd xdrf && make + clean: /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean diff --git a/source/cluster/wham/src/dfa.F b/source/cluster/wham/src/dfa.F new file mode 100644 index 0000000..576910c --- /dev/null +++ b/source/cluster/wham/src/dfa.F @@ -0,0 +1,3455 @@ + subroutine init_dfa_vars + + include 'DIMENSIONS' + include 'COMMON.INTERACT' + include 'COMMON.DFA' + + integer ii + +C Number of restraints + idisnum = 0 + iphinum = 0 + ithenum = 0 + ineinum = 0 + + idislis = 0 + iphilis = 0 + ithelis = 0 + ineilis = 0 + jneilis = 0 + jneinum = 0 + kshell = 0 + fnei = 0 +C For beta + nca = 0 + icaidx = 0 + +C real variables +CC WEIGHTS for each min + sccdist = 0.0d0 + fdist = 0.0d0 + sccphi = 0.0d0 + sccthe = 0.0d0 + sccnei = 0.0d0 + fphi1 = 0.0d0 + fphi2 = 0.0d0 + fthe1 = 0.0d0 + fthe2 = 0.0d0 +C energies + edfatot = 0.0d0 + edfadis = 0.0d0 + edfaphi = 0.0d0 + edfathe = 0.0d0 + edfanei = 0.0d0 + edfabet = 0.0d0 +C weights for each E term +C these should be identical with + dis_inc = 0.0d0 + phi_inc = 0.0d0 + the_inc = 0.0d0 + nei_inc = 0.0d0 + beta_inc = 0.0d0 + wshet = 0.0d0 +C precalculate exp table! +c dfaexp = 0.0d0 +c do ii = 1, 15001 +c dfaexp(ii) = exp(-ii*0.001d0 + 0.0005d0) +c end do + + ishiftca=nnt-1 + ilastca=nct + + print *,'ishiftca=',ishiftca,'ilastca=',ilastca + + return + end + + + subroutine read_dfa_info +C +C read fragment informations +C + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.IOUNITS' + include 'COMMON.CHAIN' + include 'COMMON.DFA' + + +C NOTE THAT FILENAMES are FIXED, CURRENTLY!! +C THIS SHOULD BE MODIFIED!! + + character*320 buffer + integer iodfa + parameter(iodfa=89) + + integer i, j, nval + integer ica1, ica2,ica3,ica4,ica5 + integer ishell, inca, itmp,iitmp + double precision wtmp +C +C READ DISTANCE +C + open(iodfa, file = 'dist_dfa.dat', status = 'old', err=33) + goto 34 + 33 write(iout,'(a)') 'Error opening dist_dfa.dat file' + stop + 34 continue + write(iout,'(a)') 'dist_dfa.dat is opened!' +C read title + read(iodfa, '(a)') buffer +C read number of restraints + read(iodfa, *) IDFADIS + read(iodfa, *) dis_inc + do i=1, idfadis + read(iodfa, '(i10,1x,i10,1x,i10)') ica1, ica2, nval + + idisnum(i)=nval + idislis(1,i)=ica1 + idislis(2,i)=ica2 + + do j=1, nval + read(iodfa,*) tmp + fdist(i,j) = tmp + enddo + + do j=1, nval + read(iodfa,*) tmp + sccdist(i,j) = tmp + enddo + + enddo + close(iodfa) + +C READ ANGLE RESTRAINTS +C PHI RESTRAINTS + open(iodfa, file='phi_dfa.dat',status='old',err=35) + goto 36 + 35 write(iout,'(a)') 'Error opening dist_dfa.dat file' + stop + + 36 continue + write(iout,'(a)') 'phi_dfa.dat is opened!' + +C READ TITLE + read(iodfa, '(a)') buffer +C READ NUMBER OF RESTRAINTS + READ(iodfa, *) IDFAPHI + read(iodfa,*) phi_inc + do i=1, idfaphi + read(iodfa,'(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval + + iphinum(i)=nval + + iphilis(1,i)=ica1 + iphilis(2,i)=ica2 + iphilis(3,i)=ica3 + iphilis(4,i)=ica4 + iphilis(5,i)=ica5 + + do j=1, nval + read(iodfa,*) tmp1,tmp2 + fphi1(i,j) = tmp1 + fphi2(i,j) = tmp2 + enddo + + do j=1, nval + read(iodfa,*) tmp + sccphi(i,j) = tmp + enddo + + enddo + close(iodfa) + +C THETA RESTRAINTS + open(iodfa, file='theta_dfa.dat',status='old',err=41) + goto 42 + 41 write(iout,'(a)') 'Error opening dist_dfa.dat file' + stop + 42 continue + write(iout,'(a)') 'theta_dfa.dat is opened!' +C READ TITLE + read(iodfa, '(a)') buffer +C READ NUMBER OF RESTRAINTS + READ(iodfa, *) IDFATHE + read(iodfa,*) the_inc + + do i=1, idfathe + read(iodfa, '(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval + + ithenum(i)=nval + + ithelis(1,i)=ica1 + ithelis(2,i)=ica2 + ithelis(3,i)=ica3 + ithelis(4,i)=ica4 + ithelis(5,i)=ica5 + + do j=1, nval + read(iodfa,*) tmp1,tmp2 + fthe1(i,j) = tmp1 + fthe2(i,j) = tmp2 + enddo + + do j=1, nval + read(iodfa,*) tmp + sccthe(i,j) = tmp + enddo + + enddo + close(iodfa) +C END of READING ANGLE RESTRAINT! + +C NUMBER OF NEIGHBOR CAs + open(iodfa,file='nei_dfa.dat',status='old',err=37) + goto 38 + 37 write(iout,'(a)') 'Error opening nei_dfa.dat file' + stop + 38 continue + write(iout,'(a)') 'nei_dfa.dat is opened!' +C READ TITLE + read(iodfa, '(a)') buffer +C READ NUMBER OF RESTRAINTS + READ(iodfa, *) idfanei + read(iodfa,*) nei_inc + + do i=1, idfanei + read(iodfa,'(2(i10,1x),i10)')ica1,ishell,nval + + ineilis(i)=ica1 + kshell(i)=ishell + ineinum(i)=nval + + do j=1, nval + read(iodfa,*) inca + fnei(i,j) = inca +C write(*,*) 'READ NEI:',i,j,fnei(i,j) + enddo + + do j=1, nval + read(iodfa,*) tmp + sccnei(i,j) = tmp + enddo + + enddo + close(iodfa) +C END OF NEIGHBORING CA + +C READ BETA RESTRAINT + open(iodfa, file='beta_dfa.dat',status='old',err=39) + goto 40 + 39 write(iout,'(a)') 'Error opening beta_dfa.dat file' + stop + 40 continue + write(iout,'(a)') 'beta_dfa.dat is opened!' + + read(iodfa,'(a)') buffer + read(iodfa,*) itmp + read(iodfa,*) beta_inc + + do i=1,itmp + read(iodfa,*) ica1, iitmp + do j=1,itmp + read(iodfa,*) wtmp + wshet(i,j) = wtmp +c write(*,*) 'BETA:',i,j,wtmp,wshet(i,j) + enddo + enddo + + close(iodfa) +C END OF BETA RESTRAINT + + return + END + + subroutine edfad(edfadis) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + double precision edfadis + integer i, iatm1, iatm2,idiff + double precision ckk, sckk,dist,texp + double precision jix,jiy,jiz,ep,fp,scc + + edfadis=0 + gdfad=0.0d0 + + do i=1, idfadis + + iatm1=idislis(1,i)+ishiftca + iatm2=idislis(2,i)+ishiftca + idiff = abs(iatm1-iatm2) + + JIX=c(1,iatm2)-c(1,iatm1) + JIY=c(2,iatm2)-c(2,iatm1) + JIZ=c(3,iatm2)-c(3,iatm1) + DIST=SQRT(JIX*JIX+JIY*JIY+JIZ*JIZ) + + ckk=ck(idiff) + sckk=sck(idiff) + + scc = 0.0d0 + ep = 0.0d0 + fp = 0.0d0 + + do j=1,idisnum(i) + + dd = dist-fdist(i,j) + dtmp = dd*dd/ckk + if (dtmp.ge.15.0d0) then + texp = 0.0d0 + else +c texp = dfaexp( idint(dtmp*1000)+1 )/sckk + texp = exp(-dtmp)/sckk + endif + + ep=ep+sccdist(i,j)*texp + fp=fp+sccdist(i,j)*texp*dd*2.0d0/ckk + scc=scc+sccdist(i,j) +C write(*,'(2i8,6f12.5)') i, j, dist, +C & fdist(i,j), ep, fp, sccdist(i,j), scc + + enddo + + ep = -ep/scc + fp = fp/scc + + +c IF(ABS(EP).lt.1.0d-20)THEN +c EP=0.0D0 +c ENDIF +c IF (ABS(FP).lt.1.0d-20) THEN +c FP=0.0D0 +c ENDIF + + edfadis=edfadis+ep*dis_inc*wwdist + + gdfad(1,iatm1) = gdfad(1,iatm1)-jix/dist*fp*dis_inc*wwdist + gdfad(2,iatm1) = gdfad(2,iatm1)-jiy/dist*fp*dis_inc*wwdist + gdfad(3,iatm1) = gdfad(3,iatm1)-jiz/dist*fp*dis_inc*wwdist + + gdfad(1,iatm2) = gdfad(1,iatm2)+jix/dist*fp*dis_inc*wwdist + gdfad(2,iatm2) = gdfad(2,iatm2)+jiy/dist*fp*dis_inc*wwdist + gdfad(3,iatm2) = gdfad(3,iatm2)+jiz/dist*fp*dis_inc*wwdist + + enddo + + return + end + + subroutine edfat(edfator) +C DFA torsion angle + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + integer i,j,ii,iii + integer iatom(5) + double precision aphi(2),athe(2),tdx(5),tdy(5),tdz(5) + double precision cwidth, cwidth2 + PARAMETER(CWIDTH=0.1D0,CWIDTH2=0.2D0,PAI=3.14159265358979323846D0) + + edfator= 0.0d0 + enephi = 0.0d0 + enethe = 0.0d0 + gdfat(:,:) = 0.0d0 + +C START OF PHI ANGLE + do i=1, idfaphi + + aphi = 0.0d0 + do iii=1,5 + iatom(iii)=iphilis(iii,i)+ishiftca + enddo + +C ANGLE VECTOR CALCULTION + RIX=C(1,IATOM(2))-C(1,IATOM(1)) + RIY=C(2,IATOM(2))-C(2,IATOM(1)) + RIZ=C(3,IATOM(2))-C(3,IATOM(1)) + + RIPX=C(1,IATOM(3))-C(1,IATOM(2)) + RIPY=C(2,IATOM(3))-C(2,IATOM(2)) + RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) + + RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) + RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) + RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) + + RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) + RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) + RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) + + GIX=RIY*RIPZ-RIZ*RIPY + GIY=RIZ*RIPX-RIX*RIPZ + GIZ=RIX*RIPY-RIY*RIPX + + GIPX=RIPY*RIPPZ-RIPZ*RIPPY + GIPY=RIPZ*RIPPX-RIPX*RIPPZ + GIPZ=RIPX*RIPPY-RIPY*RIPPX + + CIPX=C(1,IATOM(3))-C(1,IATOM(1)) + CIPY=C(2,IATOM(3))-C(2,IATOM(1)) + CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) + + CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) + CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) + CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) + + CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) + CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) + CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) + + DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) + DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) + DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) + DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) + +C END OF ANGLE VECTOR CALCULTION + + TDOT=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ + APHI(1)=TDOT/(DGI*DRIPP) + TDOT=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z + APHI(2)=TDOT/(DGIP*DRIP3) + + ephi = 0.0d0 + tfphi1=0.0d0 + tfphi2=0.0d0 + scc=0.0d0 + + do j=1, iphinum(i) + DDPS1=APHI(1)-FPHI1(i,j) + DDPS2=APHI(2)-FPHI2(i,j) + + DTMP = (DDPS1**2+DDPS2**2)/CWIDTH2 + + if (dtmp.ge.15.0d0) then + ps_tmp = 0.0d0 + else +c ps_tmp = dfaexp(idint(dtmp*1000)+1) + ps_tmp = exp(-dtmp) + endif + + ephi=ephi+sccphi(i,j)*ps_tmp + + tfphi1=tfphi1+sccphi(i,j)*ddps1/cwidth*ps_tmp + tfphi2=tfphi2+sccphi(i,j)*ddps2/cwidth*ps_tmp + + scc=scc+sccphi(i,j) +C write(*,'(2i8,8f12.6)')i,j,aphi(1),fphi1(i,j), +C & aphi(2),fphi2(i,j),tfphi1,tfphi2,ephi,sccphi(i,j) + ENDDO + + ephi=-ephi/scc*phi_inc*wwangle + tfphi1=tfphi1/scc*phi_inc*wwangle + tfphi2=tfphi2/scc*phi_inc*wwangle + + IF (ABS(EPHI).LT.1d-20) THEN + EPHI=0.0D0 + ENDIF + IF (ABS(TFPHI1).LT.1d-20) THEN + TFPHI1=0.0D0 + ENDIF + IF (ABS(TFPHI2).LT.1d-20) THEN + TFPHI2=0.0D0 + ENDIF + +C FORCE DIRECTION CALCULATION + TDX(1:5)=0.0D0 + TDY(1:5)=0.0D0 + TDZ(1:5)=0.0D0 + + DM1=1.0d0/(DGI*DRIPP) + + GIRPP=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ + DM2=GIRPP/(DGI**3*DRIPP) + DM3=GIRPP/(DGI*DRIPP**3) + + DM4=1.0d0/(DGIP*DRIP3) + + GIRP3=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z + DM5=GIRP3/(DGIP**3*DRIP3) + DM6=GIRP3/(DGIP*DRIP3**3) +C FIRST ATOM BY PHI1 + TDX(1)=(RIPZ*RIPPY-RIPY*RIPPZ)*DM1 + & +( GIZ* RIPY- GIY* RIPZ)*DM2 + TDY(1)=(RIPX*RIPPZ-RIPZ*RIPPX)*DM1 + & +( GIX* RIPZ- GIZ* RIPX)*DM2 + TDZ(1)=(RIPY*RIPPX-RIPX*RIPPY)*DM1 + & +( GIY* RIPX- GIX* RIPY)*DM2 + TDX(1)=TDX(1)*TFPHI1 + TDY(1)=TDY(1)*TFPHI1 + TDZ(1)=TDZ(1)*TFPHI1 +C SECOND ATOM BY PHI1 + TDX(2)=(CIPY*RIPPZ-CIPZ*RIPPY)*DM1 + & -(CIPY*GIZ-CIPZ*GIY)*DM2 + TDY(2)=(CIPZ*RIPPX-CIPX*RIPPZ)*DM1 + & -(CIPZ*GIX-CIPX*GIZ)*DM2 + TDZ(2)=(CIPX*RIPPY-CIPY*RIPPX)*DM1 + & -(CIPX*GIY-CIPY*GIX)*DM2 + TDX(2)=TDX(2)*TFPHI1 + TDY(2)=TDY(2)*TFPHI1 + TDZ(2)=TDZ(2)*TFPHI1 +C SECOND ATOM BY PHI2 + TDX(2)=TDX(2)+ + & ((RIPPZ*RIP3Y-RIPPY*RIP3Z)*DM4 + & +( GIPZ*RIPPY- GIPY*RIPPZ)*DM5)*TFPHI2 + TDY(2)=TDY(2)+ + & ((RIPPX*RIP3Z-RIPPZ*RIP3X)*DM4 + & +( GIPX*RIPPZ- GIPZ*RIPPX)*DM5)*TFPHI2 + TDZ(2)=TDZ(2)+ + & ((RIPPY*RIP3X-RIPPX*RIP3Y)*DM4 + & +( GIPY*RIPPX- GIPX*RIPPY)*DM5)*TFPHI2 +C THIRD ATOM BY PHI1 + TDX(3)=(-GIX+RIPPY*RIZ-RIPPZ*RIY)*DM1 + & -(GIY*RIZ-RIY*GIZ)*DM2+RIPPX*DM3 + TDY(3)=(-GIY+RIPPZ*RIX-RIPPX*RIZ)*DM1 + & -(GIZ*RIX-RIZ*GIX)*DM2+RIPPY*DM3 + TDZ(3)=(-GIZ+RIPPX*RIY-RIPPY*RIX)*DM1 + & -(GIX*RIY-RIX*GIY)*DM2+RIPPZ*DM3 + TDX(3)=TDX(3)*TFPHI1 + TDY(3)=TDY(3)*TFPHI1 + TDZ(3)=TDZ(3)*TFPHI1 +C THIRD ATOM BY PHI2 + TDX(3)=TDX(3)+ + & ((CIPPY*RIP3Z-CIPPZ*RIP3Y)*DM4 + & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5)*TFPHI2 + TDY(3)=TDY(3)+ + & ((CIPPZ*RIP3X-CIPPX*RIP3Z)*DM4 + & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5)*TFPHI2 + TDZ(3)=TDZ(3)+ + & ((CIPPX*RIP3Y-CIPPY*RIP3X)*DM4 + & -(CIPPX*GIPY-CIPPY*GIPX)*DM5)*TFPHI2 +C FOURTH ATOM BY PHI1 + TDX(4)=(GIX*DM1-RIPPX*DM3)*TFPHI1 + TDY(4)=(GIY*DM1-RIPPY*DM3)*TFPHI1 + TDZ(4)=(GIZ*DM1-RIPPZ*DM3)*TFPHI1 +C FOURTH ATOM BY PHI2 + TDX(4)=TDX(4)+ + & ((-GIPX+RIP3Y*RIPZ-RIP3Z*RIPY)*DM4 + & -( GIPY*RIPZ-RIPY*GIPZ)*DM5 + & + RIP3X*DM6)*TFPHI2 + TDY(4)=TDY(4)+ + & ((-GIPY+RIP3Z*RIPX-RIP3X*RIPZ)*DM4 + & -( GIPZ*RIPX-RIPZ*GIPX)*DM5 + & + RIP3Y*DM6)*TFPHI2 + TDZ(4)=TDZ(4)+ + & ((-GIPZ+RIP3X*RIPY-RIP3Y*RIPX)*DM4 + & -( GIPX*RIPY-RIPX*GIPY)*DM5 + & + RIP3Z*DM6)*TFPHI2 +C FIFTH ATOM BY PHI2 + TDX(5)=(GIPX*DM4-RIP3X*DM6)*TFPHI2 + TDY(5)=(GIPY*DM4-RIP3Y*DM6)*TFPHI2 + TDZ(5)=(GIPZ*DM4-RIP3Z*DM6)*TFPHI2 +C END OF FORCE DIRECTION +c force calcuation + DO II=1,5 + gdfat(1,IATOM(II))=gdfat(1,IATOM(II))+TDX(II) + gdfat(2,IATOM(II))=gdfat(2,IATOM(II))+TDY(II) + gdfat(3,IATOM(II))=gdfat(3,IATOM(II))+TDZ(II) + ENDDO +c energy calculation + enephi = enephi + ephi +c end of single assignment statement + ENDDO +C END OF PHI RESTRAINT + +C START OF THETA ANGLE + do i=1, idfathe + + athe = 0.0d0 + do iii=1,5 + iatom(iii)=ithelis(iii,i)+ishiftca + enddo + + +C ANGLE VECTOR CALCULTION + RIX=C(1,IATOM(2))-C(1,IATOM(1)) + RIY=C(2,IATOM(2))-C(2,IATOM(1)) + RIZ=C(3,IATOM(2))-C(3,IATOM(1)) + + RIPX=C(1,IATOM(3))-C(1,IATOM(2)) + RIPY=C(2,IATOM(3))-C(2,IATOM(2)) + RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) + + RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) + RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) + RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) + + RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) + RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) + RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) + + GIX=RIY*RIPZ-RIZ*RIPY + GIY=RIZ*RIPX-RIX*RIPZ + GIZ=RIX*RIPY-RIY*RIPX + + GIPX=RIPY*RIPPZ-RIPZ*RIPPY + GIPY=RIPZ*RIPPX-RIPX*RIPPZ + GIPZ=RIPX*RIPPY-RIPY*RIPPX + + GIPPX=RIPPY*RIP3Z-RIPPZ*RIP3Y + GIPPY=RIPPZ*RIP3X-RIPPX*RIP3Z + GIPPZ=RIPPX*RIP3Y-RIPPY*RIP3X + + CIPX=C(1,IATOM(3))-C(1,IATOM(1)) + CIPY=C(2,IATOM(3))-C(2,IATOM(1)) + CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) + + CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) + CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) + CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) + + CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) + CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) + CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) + + DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) + DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) + DGIPP=SQRT(GIPPX*GIPPX+GIPPY*GIPPY+GIPPZ*GIPPZ) + DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) + DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) +C END OF ANGLE VECTOR CALCULTION + + TDOT=GIX*GIPX+GIY*GIPY+GIZ*GIPZ + ATHE(1)=TDOT/(DGI*DGIP) + TDOT=GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ + ATHE(2)=TDOT/(DGIP*DGIPP) + + ETHE=0.0D0 + TFTHE1=0.0D0 + TFTHE2=0.0D0 + SCC=0.0D0 + TH_TMP=0.0d0 + + do j=1,ithenum(i) + ddth1=athe(1)-fthe1(i,j) !cos(the1)-cos(the1_ref) + ddth2=athe(2)-fthe2(i,j) !cos(the2)-cos(the2_ref) + dtmp= (ddth1**2+ddth2**2)/cwidth2 + if ( dtmp .ge. 15.0d0) then + th_tmp = 0.0d0 + else +c th_tmp = dfaexp ( idint(dtmp*1000)+1 ) + th_tmp = exp(-dtmp) + end if + + ethe=ethe+sccthe(i,j)*th_tmp + + tfthe1=tfthe1+sccthe(i,j)*ddth1/cwidth*th_tmp !-dv/dcos(the1) + tfthe2=tfthe2+sccthe(i,j)*ddth2/cwidth*th_tmp !-dv/dcos(the2) + scc=scc+sccthe(i,j) +C write(*,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), +C & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) + enddo + + ethe=-ethe/scc*the_inc*wwangle + tfthe1=tfthe1/scc*the_inc*wwangle + tfthe2=tfthe2/scc*the_inc*wwangle + + IF (ABS(ETHE).LT.TENM20) THEN + ETHE=0.0D0 + ENDIF + IF (ABS(TFTHE1).LT.TENM20) THEN + TFTHE1=0.0D0 + ENDIF + IF (ABS(TFTHE2).LT.TENM20) THEN + TFTHE2=0.0D0 + ENDIF + + TDX(1:5)=0.0D0 + TDY(1:5)=0.0D0 + TDZ(1:5)=0.0D0 + + DM1=1.0d0/(DGI*DGIP) + DM2=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI**3*DGIP) + DM3=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI*DGIP**3) + + DM4=1.0d0/(DGIP*DGIPP) + DM5=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP**3*DGIPP) + DM6=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP*DGIPP**3) + +C FIRST ATOM BY THETA1 + TDX(1)=((RIPZ*GIPY-RIPY*GIPZ)*DM1 + & -(GIY*RIPZ-GIZ*RIPY)*DM2)*TFTHE1 + TDY(1)=((-RIPZ*GIPX+RIPX*GIPZ)*DM1 + & -(-GIX*RIPZ+GIZ*RIPX)*DM2)*TFTHE1 + TDZ(1)=((RIPY*GIPX-RIPX*GIPY)*DM1 + & -(GIX*RIPY-GIY*RIPX)*DM2)*TFTHE1 +C SECOND ATOM BY THETA1 + TDX(2)=((CIPY*GIPZ-CIPZ*GIPY-RIPPY*GIZ+RIPPZ*GIY)*DM1 + & -(CIPY*GIZ-CIPZ*GIY)*DM2 + & +(RIPPY*GIPZ-RIPPZ*GIPY)*DM3)*TFTHE1 + TDY(2)=((CIPZ*GIPX-CIPX*GIPZ-RIPPZ*GIX+RIPPX*GIZ)*DM1 + & -(CIPZ*GIX-CIPX*GIZ)*DM2 + & +(RIPPZ*GIPX-RIPPX*GIPZ)*DM3)*TFTHE1 + TDZ(2)=((CIPX*GIPY-CIPY*GIPX-RIPPX*GIY+RIPPY*GIX)*DM1 + & -(CIPX*GIY-CIPY*GIX)*DM2 + & +(RIPPX*GIPY-RIPPY*GIPX)*DM3)*TFTHE1 +C SECOND ATOM BY THETA2 + TDX(2)=TDX(2)+ + & ((RIPPZ*GIPPY-RIPPY*GIPPZ)*DM4 + & -(GIPY*RIPPZ-GIPZ*RIPPY)*DM5)*TFTHE2 + TDY(2)=TDY(2)+ + & ((-RIPPZ*GIPPX+RIPPX*GIPPZ)*DM4 + & -(-GIPX*RIPPZ+GIPZ*RIPPX)*DM5)*TFTHE2 + TDZ(2)=TDZ(2)+ + & ((RIPPY*GIPPX-RIPPX*GIPPY)*DM4 + & -(GIPX*RIPPY-GIPY*RIPPX)*DM5)*TFTHE2 +C THIRD ATOM BY THETA1 + TDX(3)=((GIPY*RIZ-GIPZ*RIY-GIY*CIPPZ+GIZ*CIPPY)*DM1 + & -(GIY*RIZ-GIZ*RIY)*DM2 + & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM3) *TFTHE1 + TDY(3)=((GIPZ*RIX-GIPX*RIZ-GIZ*CIPPX+GIX*CIPPZ)*DM1 + & -(GIZ*RIX-GIX*RIZ)*DM2 + & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM3) *TFTHE1 + TDZ(3)=((GIPX*RIY-GIPY*RIX-GIX*CIPPY+GIY*CIPPX)*DM1 + & -(GIX*RIY-GIY*RIX)*DM2 + & -(CIPPX*GIPY-CIPPY*GIPX)*DM3) *TFTHE1 +C THIRD ATOM BY THETA2 + TDX(3)=TDX(3)+ + & ((CIPPY*GIPPZ-CIPPZ*GIPPY-RIP3Y*GIPZ+RIP3Z*GIPY)*DM4 + & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5 + & +(RIP3Y*GIPpZ-RIP3Z*GIPpY)*DM6) *TFTHE2 + TDY(3)=TDY(3)+ + & ((CIPPZ*GIPPX-CIPPX*GIPPZ-RIP3Z*GIPX+RIP3X*GIPZ)*DM4 + & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5 + & +(RIP3Z*GIPpX-RIP3X*GIPpZ)*DM6) *TFTHE2 + TDZ(3)=TDZ(3)+ + & ((CIPPX*GIPPY-CIPPY*GIPPX-RIP3X*GIPY+RIP3Y*GIPX)*DM4 + & -(CIPPX*GIPY-CIPPY*GIPX)*DM5 + & +(RIP3X*GIPpY-RIP3Y*GIPpX)*DM6) *TFTHE2 +C FOURTH ATOM BY THETA1 + TDX(4)=-((GIZ*RIPY-GIY*RIPZ)*DM1 + & -(GIPZ*RIPY-GIPY*RIPZ)*DM3) *TFTHE1 + TDY(4)=-((GIX*RIPZ-GIZ*RIPX)*DM1 + & -(GIPX*RIPZ-GIPZ*RIPX)*DM3) *TFTHE1 + TDZ(4)=-((GIY*RIPX-GIX*RIPY)*DM1 + & -(GIPY*RIPX-GIPX*RIPY)*DM3) *TFTHE1 +C FOURTH ATOM BY THETA2 + TDX(4)=TDX(4)+ + & ((GIPPY*RIPZ-GIPPZ*RIPY-GIPY*CIP3Z+GIPZ*CIP3Y)*DM4 + & -(GIPY*RIPZ-GIPZ*RIPY)*DM5 + & -(CIP3Y*GIPPZ-CIP3Z*GIPPY)*DM6)*TFTHE2 + TDY(4)=TDY(4)+ + & ((GIPPZ*RIPX-GIPPX*RIPZ-GIPZ*CIP3X+GIPX*CIP3Z)*DM4 + & -(GIPZ*RIPX-GIPX*RIPZ)*DM5 + & -(CIP3Z*GIPPX-CIP3X*GIPPZ)*DM6)*TFTHE2 + TDZ(4)=TDZ(4)+ + & ((GIPPX*RIPY-GIPPY*RIPX-GIPX*CIP3Y+GIPY*CIP3X)*DM4 + & -(GIPX*RIPY-GIPY*RIPX)*DM5 + & -(CIP3X*GIPPY-CIP3Y*GIPPX)*DM6)*TFTHE2 +C FIFTH ATOM BY THETA2 + TDX(5)=-((GIPZ*RIPPY-GIPY*RIPPZ)*DM4 + & -(GIPPZ*RIPPY-GIPPY*RIPPZ)*DM6)*TFTHE2 + TDY(5)=-((GIPX*RIPPZ-GIPZ*RIPPX)*DM4 + & -(GIPPX*RIPPZ-GIPPZ*RIPPX)*DM6)*TFTHE2 + TDZ(5)=-((GIPY*RIPPX-GIPX*RIPPY)*DM4 + & -(GIPPY*RIPPX-GIPPX*RIPPY)*DM6)*TFTHE2 +C !! END OF FORCE DIRECTION!!!! + DO II=1,5 + gdfat(1,iatom(II))=gdfat(1,iatom(II))+TDX(II) + gdfat(2,iatom(II))=gdfat(2,iatom(II))+TDY(II) + gdfat(3,iatom(II))=gdfat(3,iatom(II))+TDZ(II) + ENDDO +C energy calculation + enethe = enethe + ethe + ENDDO + + edfator = enephi + enethe + + RETURN + END + + subroutine edfan(edfanei) +C DFA neighboring CA restraint + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + integer i,j,imin + integer kshnum, n1atom + + double precision enenei,tmp_n + double precision pai,hpai + double precision jix,jiy,jiz,ndiff,snorm_nei + double precision t2dx(maxres),t2dy(maxres),t2dz(maxres) + double precision dr,dr2,half,ntmp,dtmp + + parameter(dr=0.25d0,dr2=0.50d0,half=0.50d0) + parameter(pai=3.14159265358979323846D0) + parameter(hpai=1.5707963267948966D0) + parameter(snorm_nei=0.886226925452758D0) + + edfanei = 0.0d0 + enenei = 0.0d0 + gdfan = 0.0d0 + +c print*, 's1:', s1(:) +c print*, 's2:', s2(:) + + do i=1, idfanei + + kshnum=kshell(i) + n1atom=ineilis(i)+ishiftca +C write(*,*) 'kshnum,n1atom:', kshnum, n1atom + + tmp_n=0.0d0 + ftmp=0.0d0 + dnei=0.0d0 + dist=0.0d0 + t1dx=0.0d0 + t1dy=0.0d0 + t1dz=0.0d0 + t2dx=0.0d0 + t2dy=0.0d0 + t2dz=0.0d0 + + do j = ishiftca+1, ilastca + + if (n1atom.eq.j) cycle + + jix=c(1,j)-c(1,n1atom) + jiy=c(2,j)-c(2,n1atom) + jiz=c(3,j)-c(3,n1atom) + dist=sqrt(jix*jix+jiy*jiy+jiz*jiz) + +c write(*,*) n1atom, j, dist + + if(kshnum.ne.1)then + if (dist.lt.s1(kshnum).and. + & dist.gt.s2(kshnum-1)) then + + tmp_n=tmp_n+1.0d0 + +c write(*,*) 'case1:',tmp_n + + t1dx=t1dx+0.0d0 + t1dy=t1dy+0.0d0 + t1dz=t1dz+0.0d0 + t2dx(j)=0.0d0 + t2dy(j)=0.0d0 + t2dz(j)=0.0d0 + + elseif(dist.ge.s1(kshnum).and. + & dist.le.s2(kshnum)) then + + dnei=(dist-s1(kshnum))/dr2*pai + tmp_n=tmp_n + half*(1+cos(dnei)) +c write(*,*) 'case2:',tmp_n + ftmp=-pai*sin(dnei)/dr2/dist/2.0d0 +c center atom + t1dx=t1dx+jix*ftmp + t1dy=t1dy+jiy*ftmp + t1dz=t1dz+jiz*ftmp +c neighbor atoms + t2dx(j)=-jix*ftmp + t2dy(j)=-jiy*ftmp + t2dz(j)=-jiz*ftmp +c + elseif(dist.ge.s1(kshnum-1).and. + & dist.le.s2(kshnum-1)) then + dnei=(dist-s1(kshnum-1))/dr2*pai + tmp_n=tmp_n + 1.0d0 - half*(1+cos(dnei)) +c write(*,*) 'case3:',tmp_n + ftmp = hpai*sin(dnei)/dr2/dist +c center atom + t1dx=t1dx+jix*ftmp + t1dy=t1dy+jiy*ftmp + t1dz=t1dz+jiz*ftmp +c neighbor atoms + t2dx(j)=-jix*ftmp + t2dy(j)=-jiy*ftmp + t2dz(j)=-jiz*ftmp + + endif + + elseif(kshnum.eq.1) then + + if(dist.lt.s1(kshnum))then + + tmp_n=tmp_n+1.0d0 +c write(*,*) 'case4:',tmp_n + t1dx=t1dx+0.0d0 + t1dy=t1dy+0.0d0 + t1dz=t1dz+0.0d0 + t2dx(j)=0.0d0 + t2dy(j)=0.0d0 + t2dz(j)=0.0d0 + + elseif(dist.ge.s1(kshnum).and. + & dist.le.s2(kshnum))then + + dnei=(dist-s1(kshnum))/dr2*pai + tmp_n=tmp_n + half*(1+cos(dnei)) +c write(*,*) 'case5:',tmp_n + ftmp = -hpai*sin(dnei)/dr2/dist +c center atom + t1dx=t1dx+jix*ftmp + t1dy=t1dy+jiy*ftmp + t1dz=t1dz+jiz*ftmp +c neighbor atoms + t2dx(j)=-jix*ftmp + t2dy(j)=-jiy*ftmp + t2dz(j)=-jiz*ftmp + + endif + endif + enddo + + scc=0.0d0 + enei=0.0d0 + tmp_fnei=0.0d0 + ndiff=0.0d0 + + do imin=1,ineinum(i) + + ndiff = tmp_n-fnei(i,imin) + dtmp = ndiff*ndiff + + if (dtmp.ge.15.0d0) then + ntmp = 0.0d0 + else +c ntmp = dfaexp( idint(dtmp*1000) + 1 ) + ntmp = exp(-dtmp) + end if + + enei=enei+sccnei(i,imin)*ntmp + tmp_fnei=tmp_fnei- + & sccnei(i,imin)*ntmp*ndiff*2.0d0 + scc=scc+sccnei(i,imin) + +c write(*,'(a,1x,2i8,f12.7,i8,3f12.7)')'NEI:',i,imin,tmp_n, +c & fnei(i,imin),sccnei(i,imin),enei,scc + enddo + + enei=-enei/scc*snorm_nei*nei_inc*wwnei + tmp_fnei=tmp_fnei/scc*snorm_nei*nei_inc*wwnei + +c if (abs(enei).lt.1.0d-20)then +c enei=0.0d0 +c endif +c if (abs(tmp_fnei).lt.1.0d-20) then +c tmp_fnei=0.0d0 +c endif + +c force calculation + t1dx=t1dx*tmp_fnei + t1dy=t1dy*tmp_fnei + t1dz=t1dz*tmp_fnei + + do j=ishiftca+1,ilastca + t2dx(j)=t2dx(j)*tmp_fnei + t2dy(j)=t2dy(j)*tmp_fnei + t2dz(j)=t2dz(j)*tmp_fnei + enddo + + gdfan(1,n1atom)=gdfan(1,n1atom)+t1dx + gdfan(2,n1atom)=gdfan(2,n1atom)+t1dy + gdfan(3,n1atom)=gdfan(3,n1atom)+t1dz + + do j=ishiftca+1,ilastca + gdfan(1,j)=gdfan(1,j)+t2dx(j) + gdfan(2,j)=gdfan(2,j)+t2dy(j) + gdfan(3,j)=gdfan(3,j)+t2dz(j) + enddo +c energy calculation + + enenei=enenei+enei + + enddo + + edfanei=enenei + + return + end + + subroutine edfab(edfabeta) + + implicit real*8 (a-h,o-z) + + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + real*8 PAI + parameter(PAI=3.14159265358979323846D0) + parameter (maxca=800) +C sheet variables + real*8 bx(maxres),by(maxres),bz(maxres) + real*8 vbet(maxres,maxres) + real*8 shetfx(maxres),shetfy(maxres),shetfz(maxres) + real*8 shefx(maxres,12),shefy(maxres,12),shefz(maxres,12) + real*8 vbeta,vbetp,vbetm + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + & c00,s00,ulnex,dnex + real*8 dp45,dm45,w_beta + + real*8 cph(maxca),cth(maxca) + real*8 atx(maxca),aty(maxca),atz(maxca) + real*8 atmx(maxca),atmy(maxca),atmz(maxca) + real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) + real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) + real*8 sth(maxca) + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + + real*8 atxnum(maxca),atynum(maxca),atznum(maxca), + & astxnum(maxca),astynum(maxca),astznum(maxca), + & atmxnum(maxca),atmynum(maxca),atmznum(maxca), + & astmxnum(maxca),astmynum(maxca),astmznum(maxca), + & atmmxnum(maxca),atmmynum(maxca),atmmznum(maxca), + & astmmxnum(maxca),astmmynum(maxca),astmmznum(maxca), + & atm3xnum(maxca),atm3ynum(maxca),atm3znum(maxca), + & astm3xnum(maxca),astm3ynum(maxca),astm3znum(maxca), + & cth_orig(maxca),sth_orig(maxca) + + common /sheca/ bx,by,bz + common /shee/ vbeta,vbet,vbetp,vbetm + common /shetf/ shetfx,shetfy,shetfz + common /shef/ shefx, shefy, shefz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + & c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + + common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, + $ atmmz,atm3x,atm3y,atm3z + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + $ astmmz,astm3x,astm3y,astm3z + + common /coscos/ cph,cth + common /sinsin/ sth + +C End of sheet variables + + integer i,j + double precision enebet + + enebet=0.0d0 + bx=0.0d0;by=0.0d0;bz=0.0d0 + shetfx=0.0d0;shetfy=0.0d0;shetfz=0.0d0 + + gdfab=0.0d0 + + do i=ishiftca+1,ilastca + bx(i-ishiftca)=c(1,i) + by(i-ishiftca)=c(2,i) + bz(i-ishiftca)=c(3,i) + enddo + +c do i=1,ilastca-ishiftca +c read(99,*) bx(i),by(i),bz(i) +c enddo +c close(99) + + dca=0.25d0**2 + dshe=0.3d0**2 + ULHB=5.0D0 + ULDHB=5.0D0 + ULNEX=COS(60.0D0/180.0D0*PAI) + + DLHB=1.0D0 + DLDHB=1.0D0 + + DNEX=0.3D0**2 + + C00=COS((1.0D0+10.0D0/180.0D0)*PAI) + S00=SIN((1.0D0+10.0D0/180.0D0)*PAI) + + W_BETA=0.5D0 + DP45=W_BETA + DM45=W_BETA + +C END OF INITIALIZATION + + nca=ilastca-ishiftca + + call angvectors(nca) + call sheetforce(nca,wshet) + +c end of sheet energy and force + + do j=1,nca + shetfx(j)=shetfx(j)*beta_inc + shetfy(j)=shetfy(j)*beta_inc + shetfz(j)=shetfz(j)*beta_inc +c write(*,*)'SHETF:',shetfx(j),shetfy(j),shetfz(j) + enddo + + vbeta=vbeta*beta_inc + enebet=vbeta + edfabeta=enebet + + do j=1,nca + gdfab(1,j+ishiftca)=gdfab(1,j+ishiftca)-shetfx(j) + gdfab(2,j+ishiftca)=gdfab(2,j+ishiftca)-shetfy(j) + gdfab(3,j+ishiftca)=gdfab(3,j+ishiftca)-shetfz(j) + enddo + +#ifdef DEBUG1 + do j=1,nca + write(*,'(5x,i5,10x,3f10.5)') j,bx(j),by(j),bz(j) + enddo + + + gdfab=0 + dinc=0.001 + do j=1,nca + cth_orig(j)=cth(j) + sth_orig(j)=sth(j) + enddo + + do j=1,nca + + bx(j)=bx(j)+dinc + call angvectors(nca) + bx(j)=bx(j)-2*dinc + call angvectors(nca) + atxnum(j)=0.5*(cth(j)-cth_orig(j))/dinc + astxnum(j)=0.5*(sth(j)-sth_orig(j))/dinc + if (j.gt.1) then + atmxnum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc + astmxnum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc + endif + if (j.gt.2) then + atmmxnum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc + astmmxnum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc + endif + if (j.gt.3) then + atm3xnum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc + astm3xnum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc + endif + bx(j)=bx(j)+dinc + by(j)=by(j)+dinc + call angvectors(nca) + by(j)=by(j)-2*dinc + call angvectors(nca) + by(j)=by(j)+dinc + atynum(j)=0.5*(cth(j)-cth_orig(j))/dinc + astynum(j)=0.5*(sth(j)-sth_orig(j))/dinc + if (j.gt.1) then + atmynum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc + astmynum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc + endif + if (j.gt.2) then + atmmynum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc + astmmynum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc + endif + if (j.gt.3) then + atm3ynum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc + astm3ynum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc + endif + + bz(j)=bz(j)+dinc + call angvectors(nca) + bz(j)=bz(j)-2*dinc + call angvectors(nca) + bz(j)=bz(j)+dinc + + atznum(j)=0.5*(cth(j)-cth_orig(j))/dinc + astznum(j)=0.5*(sth(j)-sth_orig(j))/dinc + if (j.gt.1) then + atmznum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc + astmznum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc + endif + if (j.gt.2) then + atmmznum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc + astmmznum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc + endif + if (j.gt.3) then + atm3znum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc + astm3znum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc + endif + + enddo + + do i=1,nca + write (*,'(2i5,a2,6f10.5)') + & i,1,"x",atxnum(i),atx(i),atxnum(i)/atx(i), + & astxnum(i),astx(i),astxnum(i)/astx(i), + & i,1,"y",atynum(i),aty(i),atynum(i)/aty(i), + & astynum(i),asty(i),astynum(i)/asty(i), + & i,1,"z",atznum(i),atz(i),atznum(i)/atz(i), + & astznum(i),astz(i),astznum(i)/astz(i), + & i,2,"x",atmxnum(i),atmx(i),atmxnum(i)/atmx(i), + & astmxnum(i),astmx(i),astmxnum(i)/astmx(i), + & i,2,"y",atmynum(i),atmy(i),atmynum(i)/atmy(i), + & astmynum(i),astmy(i),astmynum(i)/astmy(i), + & i,2,"z",atmznum(i),atmz(i),atmznum(i)/atmz(i), + & astmznum(i),astmz(i),astmznum(i)/astmz(i), + & i,3,"x",atmmxnum(i),atmmx(i),atmmxnum(i)/atmmx(i), + & astmmxnum(i),astmmx(i),astmmxnum(i)/astmmx(i), + & i,3,"y",atmmynum(i),atmmy(i),atmmynum(i)/atmmy(i), + & astmmynum(i),astmmy(i),astmmynum(i)/astmmy(i), + & i,3,"z",atmmznum(i),atmmz(i),atmmznum(i)/atmmz(i), + & astmmznum(i),astmmz(i),astmmznum(i)/astmmz(i), + & i,4,"x",atm3xnum(i),atm3x(i),atm3xnum(i)/atm3x(i), + & astm3xnum(i),astm3x(i),astm3xnum(i)/astm3x(i), + & i,4,"y",atm3ynum(i),atm3y(i),atm3ynum(i)/atm3y(i), + & astm3ynum(i),astm3y(i),astm3ynum(i)/astm3y(i), + & i,4,"z",atm3znum(i),atm3z(i),atm3znum(i)/atm3z(i), + & astm3znum(i),astm3z(i),astm3znum(i)/astm3z(i), + & i,0," ",cth_orig(i),sth_orig(i) + enddo + + + gdfab=0 + dinc=0.001 + + do j=1,nca + + bx(j)=bx(j)+dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta1=vbeta*beta_inc + bx(j)=bx(j)-2*dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta2=vbeta*beta_inc + gdfab(1,j)=(vbeta2-vbeta1)/dinc/2 + bx(j)=bx(j)+dinc + + by(j)=by(j)+dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta1=vbeta*beta_inc + by(j)=by(j)-2*dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta2=vbeta*beta_inc + gdfab(2,j)=(vbeta2-vbeta1)/dinc/2 + by(j)=by(j)+dinc + + bz(j)=bz(j)+dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta1=vbeta*beta_inc + bz(j)=bz(j)-2*dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta2=vbeta*beta_inc + gdfab(3,j)=(vbeta2-vbeta1)/dinc/2 + bz(j)=bz(j)+dinc + + + enddo + + + call angvectors(nca) + call sheetforce(nca,wshet) + do j=1,nca + shetfx(j)=shetfx(j)*beta_inc + shetfy(j)=shetfy(j)*beta_inc + shetfz(j)=shetfz(j)*beta_inc + enddo + + + write(*,*) 'xyz analytical and numerical gradient' + do j=1,nca + write(*,'(5x,i5,10x,6f10.5)') j,-shetfx(j),-shetfy(j),-shetfz(j) + & ,(-gdfab(i,j),i=1,3) + enddo + + do j=1,nca + write(*,'(5x,i5,10x,3f10.2)') j,shetfx(j)/gdfab(1,j), + & shetfy(j)/gdfab(2,j), + & shetfz(j)/gdfab(3,j) + enddo + + stop +#endif + + return + end +C------------------------------------------------------------------------------- + subroutine angvectors(nca) +c implicit real*4(a-h,o-z) + implicit none + integer nca + integer maxca + parameter(maxca=800) + real*8 pai,zero + parameter(PAI=3.14159265358979323846D0,zero=0.0d0) + + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 apx(maxca),apy(maxca),apz(maxca) + real*8 apmx(maxca),apmy(maxca),apmz(maxca) + real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) + real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) + real*8 atx(maxca),aty(maxca),atz(maxca) + real*8 atmx(maxca),atmy(maxca),atmz(maxca) + real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) + real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + real*8 sth(maxca) + real*8 cph(maxca),cth(maxca) + real*8 ulcos(maxca) + real*8 p,c + integer i, ip, ipp, ip3, j + real*8 rx(maxca, maxca), ry(maxca, maxca), rz(maxca, maxca) + real*8 rix, riy, riz, ripx, ripy, ripz, rippx, rippy, rippz + real*8 gix, giy, giz, gipx, gipy, gipz, gippx, gippy, gippz + real*8 cix, ciy, ciz, cipx, cipy, cipz + real*8 gpcrp_x, gpcrp_y, gpcrp_z, d_gpcrp, gpcrp__g + real*8 d10, d11, d12, d13, d20, d21, d22, d23, d24 + real*8 d30, d31, d32, d33, d34, d35, d40, d41, d42, d43 + real*8 d_gcr, d_gcr3, d_gmcrim,d_gmcrim3,dgmmcrimm,d_gmmcrimm3 + real*8 dg, dg3, dg30, dgm, dgm3, dgmm, dgmm3, dgp, dri + real*8 dri3, drim, drim3, drimm, drip, dripp, g3gmm, g3rim + real*8 g3x, g3y, g3z, d_gmmcrimm, g3rim_,gcr__gm + real*8 gcr_x,gcr_y,gcr_z,ggm,ggp,gmcrim__gmm + real*8 gmcrim_x,gmcrim_y,gmcrim_z,gmmcrimm__gmmm + real*8 gmmcrimm_x,gmmcrimm_y,gmmcrimm_z,gmmgm,gmmr + real*8 gmmx,gmmy,gmmz,gmrp,gmx,gmy,gmz,gpx,gpy,gpz + real*8 grpp,gx,gy,gz + real*8 rim3x,rim3y,rim3z,rimmx,rimmy,rimmz,rimx,rimy,rimz + real*8 sd10,sd11,sd20,sd21,sd22,sd30,sd31,sd32,sd40,sd41 + integer inb,nmax,iselect + + common /sheca/ bx,by,bz + common /difvec/ rx, ry, rz + common /ulang/ ulcos + common /phys1/ inb,nmax,iselect + common /phys4/ p,c + common /kyori2/ dis + common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, + & apmmz,apm3x,apm3y,apm3z + common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, + & atmmz,atm3x,atm3y,atm3z + common /coscos/ cph,cth + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + & astmmz,astm3x,astm3y,astm3z + common /sinsin/ sth +C------------------------------------------------------------------------------- +c write(*,*) 'inside angvectors' +C initialize + p=0.1d0 + c=1.0d0 + inb=nca + cph=zero; cth=zero; sth=zero + apx=zero;apy=zero;apz=zero;apmx=zero;apmy=zero;apmz=zero + apmmx=zero;apmmy=zero;apmmz=zero;apm3x=zero;apm3y=zero;apm3z=zero + atx=zero;aty=zero;atz=zero;atmx=zero;atmy=zero;atmz=zero + atmmx=zero;atmmy=zero;atmmz=zero;atm3x=zero;atm3y=zero;atm3z=zero + astx=zero;asty=zero;astz=zero;astmx=zero;astmy=zero;astmz=zero + astmmx=zero;astmmy=zero;astmmz=zero;astm3x=zero;astm3y=zero + astm3z=zero +C end of initialize +C r[x,y,z] calc and distance calculation + rx=zero;ry=zero;rz=zero + + do i=1,inb + do j=1,inb + rx(i,j)=bx(j)-bx(i) + ry(i,j)=by(j)-by(i) + rz(i,j)=bz(j)-bz(i) + dis(i,j)=sqrt(rx(i,j)**2+ry(i,j)**2+rz(i,j)**2) +c write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) +c write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) +c write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) +c write(*,*) 'dis(i,j):',i,j,dis(i,j) + enddo + enddo +c end of r[x,y,z] calc +C cos calc + do i=1,inb-2 + ip=i+1 + ipp=i+2 + + if(dis(i,ip).ge.1.0e-8.and.dis(ip,ipp).ge.1.0e-8) then + ulcos(i)=rx(i,ip)*rx(ip,ipp)+ry(i,ip)*ry(ip,ipp) + $ +rz(i,ip)*rz(ip,ipp) + ulcos(i)=ulcos(i)/(dis(i,ip)*dis(ip,ipp)) + endif + enddo +c end of virtual bond angle +c write(*,*) 'inside angvectors1' +crc do i=1,inb-3 + do i=1,inb + ip=i+1 + ipp=i+2 + ip3=i+3 + rix=bx(ip)-bx(i) + riy=by(ip)-by(i) + riz=bz(ip)-bz(i) + ripx=bx(ipp)-bx(ip) + ripy=by(ipp)-by(ip) + ripz=bz(ipp)-bz(ip) + rippx=bx(ip3)-bx(ipp) + rippy=by(ip3)-by(ipp) + rippz=bz(ip3)-bz(ipp) + + gx=riy*ripz-riz*ripy + gy=riz*ripx-rix*ripz + gz=rix*ripy-riy*ripx + gpx=ripy*rippz-ripz*rippy + gpy=ripz*rippx-ripx*rippz + gpz=ripx*rippy-ripy*rippx + gpcrp_x=gpy*ripz-gpz*ripy + gpcrp_y=gpz*ripx-gpx*ripz + gpcrp_z=gpx*ripy-gpy*ripx + d_gpcrp=sqrt(gpcrp_x**2+gpcrp_y**2+gpcrp_z**2) + gpcrp__g=gx*gpy*ripz+gpx*ripy*gz+ripx*gpz*gy + & -gz*gpy*ripx-gpz*ripy*gx-ripz*gpx*gy + + if(i.ge.2) then + rimx=bx(i)-bx(i-1) + rimy=by(i)-by(i-1) + rimz=bz(i)-bz(i-1) + gmx=rimy*riz-rimz*riy + gmy=rimz*rix-rimx*riz + gmz=rimx*riy-rimy*rix + dgm=sqrt(gmx**2+gmy**2+gmz**2) + dgm3=dgm**3 + ggm=gmx*gx+gmy*gy+gmz*gz + gmrp=gmx*ripx+gmy*ripy+gmz*ripz + drim=dis(i-1,i) + drim3=drim**3 + gcr_x=gy*riz-gz*riy + gcr_y=gz*rix-gx*riz + gcr_z=gx*riy-gy*rix + d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) + d_gcr3=d_gcr**3 + gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy + & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy + endif +c write(*,*) 'inside angvectors2' + if(i.ge.3) then + rimmx=bx(i-1)-bx(i-2) + rimmy=by(i-1)-by(i-2) + rimmz=bz(i-1)-bz(i-2) + drimm=dis(i-2,i-1) + gmmx=rimmy*rimz-rimmz*rimy + gmmy=rimmz*rimx-rimmx*rimz + gmmz=rimmx*rimy-rimmy*rimx + dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) + dgmm3=dgmm**3 + gmmgm=gmmx*gmx+gmmy*gmy+gmmz*gmz + gmmr=gmmx*rix+gmmy*riy+gmmz*riz + gmcrim_x=gmy*rimz-gmz*rimy + gmcrim_y=gmz*rimx-gmx*rimz + gmcrim_z=gmx*rimy-gmy*rimx + d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) + d_gmcrim3=d_gmcrim**3 + gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy + & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy + endif + + if(i.ge.4) then + rim3x=bx(i-2)-bx(i-3) + rim3y=by(i-2)-by(i-3) + rim3z=bz(i-2)-bz(i-3) + g3x=rim3y*rimmz-rim3z*rimmy + g3y=rim3z*rimmx-rim3x*rimmz + g3z=rim3x*rimmy-rim3y*rimmx + dg30=sqrt(g3x**2+g3y**2+g3z**2) + g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz + g3rim_=g3x*rimx+g3y*rimy+g3z*rimz +cc********************************************************************** + gmmcrimm_x=gmmy*rimmz-gmmz*rimmy + gmmcrimm_y=gmmz*rimmx-gmmx*rimmz + gmmcrimm_z=gmmx*rimmy-gmmy*rimmx + d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) + d_gmmcrimm3=d_gmmcrimm**3 + gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y + & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y + endif + + dri=dis(i,i+1) + drip=dis(i+1,i+2) + dripp=dis(i+2,i+3) + dri3=dri**3 + dg=sqrt(gx**2+gy**2+gz**2) + dgp=sqrt(gpx**2+gpy**2+gpz**2) + dg3=dg**3 + + ggp=gx*gpx+gy*gpy+gz*gpz + grpp=gx*rippx+gy*rippy+gz*rippz + + if(dg.gt.0.0D0.and.dripp.gt.0.0D0.and.dgp.gt.0.0D0 + & .and.d_gpcrp.gt.0.0D0) then + cph(i)=grpp/dg/dripp + cth(i)=ggp/dg/dgp + sth(i)=gpcrp__g/d_gpcrp/dg + else +c + cph(i)=1.0D0 + cth(i)=1.0D0 + sth(i)=0.0D0 + endif + +c write(*,*) 'inside angvectors3' + + if(dgp.gt.0.0D0.and.dg3.gt.0.0D0 + & .and.dripp.gt.0.0D0.and.d_gpcrp.gt.0.0D0) then + d10=1.0D0/(dg*dgp) + d11=ggp/(dg3*dgp) + d12=1.0D0/(dg*dripp) + d13=grpp/(dg3*dripp) + sd10=1.0D0/(d_gpcrp*dg) + sd11=gpcrp__g/(d_gpcrp*dg3) + else + d10=0.0D0 + d11=0.0D0 + d12=0.0D0 + d13=0.0D0 + sd10=0.0D0 + sd11=0.0D0 + endif + + atx(i)=(ripz*gpy-ripy*gpz)*d10 + & -(gy*ripz-gz*ripy)*d11 + aty(i)=(ripx*gpz-ripz*gpx)*d10 + & -(gz*ripx-gx*ripz)*d11 + atz(i)=(ripy*gpx-ripx*gpy)*d10 + & -(gx*ripy-gy*ripx)*d11 + astx(i)=sd10*(-gpx*ripy**2+ripx*gpz*ripz + & +ripy*gpy*ripx-gpx*ripz**2) + & -sd11*(gy*ripz-gz*ripy) + asty(i)=sd10*(-gpy*ripz**2+gpx*ripy*ripx + & -gpy*ripx**2+gpz*ripy*ripz) + & -sd11*(-gx*ripz+gz*ripx) + astz(i)=sd10*(ripy*gpy*ripz-gpz*ripx**2 + & -gpz*ripy**2+ripz*gpx*ripx) + & -sd11*(gx*ripy-gy*ripx) + apx(i)=(ripz*rippy-ripy*rippz)*d12 + & -(gy*ripz-gz*ripy)*d13 + apy(i)=(ripx*rippz-ripz*rippx)*d12 + & -(gz*ripx-gx*ripz)*d13 + apz(i)=(ripy*rippx-ripx*rippy)*d12 + & -(gx*ripy-gy*ripx)*d13 + + if(i.ge.2) then + cix=bx(ip)-bx(i-1) + ciy=by(ip)-by(i-1) + ciz=bz(ip)-bz(i-1) + cipx=bx(ipp)-bx(i) + cipy=by(ipp)-by(i) + cipz=bz(ipp)-bz(i) + ripx=bx(ipp)-bx(ip) + ripy=by(ipp)-by(ip) + ripz=bz(ipp)-bz(ip) + if(dgm3.gt.0.0D0.and.dg3.gt.0.0D0.and.drip.gt.0.0D0 + & .and.d_gcr3.gt.0.0D0) then + d20=1.0D0/(dg*dgm) + d21=ggm/(dgm3*dg) + d22=ggm/(dgm*dg3) + d23=1.0D0/(dgm*drip) + d24=gmrp/(dgm3*drip) + sd20=1.0D0/(d_gcr*dgm) + sd21=gcr__gm/(d_gcr3*dgm) + sd22=gcr__gm/(d_gcr*dgm3) + else + d20=0.0D0 + d21=0.0D0 + d22=0.0D0 + d23=0.0D0 + d24=0.0D0 + sd20=0.0D0 + sd21=0.0D0 + sd22=0.0D0 + endif + atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 + & -(ciy*gmz-ciz*gmy)*d21 + & +(ripy*gz-ripz*gy)*d22 + atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 + & -(ciz*gmx-cix*gmz)*d21 + & +(ripz*gx-ripx*gz)*d22 + atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 + & -(cix*gmy-ciy*gmx)*d21 + & +(ripx*gy-ripy*gx)*d22 +cc********************************************************************** + astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy + & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix + & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) + & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) + & +gcr_z*(-ripz*rix+gy)) + & -sd22*(-gmy*ciz+gmz*ciy) + + astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix + & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz + & +riz*ripz*gmy) + & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) + & -gcr_z*(ripz*riy+gx)) + & -sd22*(gmx*ciz-gmz*cix) + + astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz + & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy + & -riz*gx*cix) + & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) + & +gcr_z*(ripy*riy+ripx*rix)) + & -sd22*(-gmx*ciy+gmy*cix) +cc********************************************************************** + apmx(i)=(ciy*ripz-ripy*ciz)*d23 + & -(ciy*gmz-ciz*gmy)*d24 + apmy(i)=(ciz*ripx-ripz*cix)*d23 + & -(ciz*gmx-cix*gmz)*d24 + apmz(i)=(cix*ripy-ripx*ciy)*d23 + & -(cix*gmy-ciy*gmx)*d24 + endif + + if(i.ge.3) then + if(dgm3.gt.0.0D0.and.dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 + & .and.d_gmcrim3.gt.0.0D0) then + d30=1.0D0/(dgm*dgmm) + d31=gmmgm/(dgm3*dgmm) + d32=gmmgm/(dgm*dgmm3) + d33=1.0D0/(dgmm*dri) + d34=gmmr/(dgmm3*dri) + d35=gmmr/(dgmm*dri3) + sd30=1.0D0/(d_gmcrim*dgmm) + sd31=gmcrim__gmm/(d_gmcrim3*dgmm) + sd32=gmcrim__gmm/(d_gmcrim*dgmm3) + else + d30=0.0D0 + d31=0.0D0 + d32=0.0D0 + d33=0.0D0 + d34=0.0D0 + d35=0.0D0 + sd30=0.0D0 + sd31=0.0D0 + sd32=0.0D0 + endif + +c write(*,*) 'inside angvectors4' + +cc********************************************************************** + atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 + & -(ciy*gmz-ciz*gmy)*d31 + & -(gmmy*rimmz-gmmz*rimmy)*d32 + atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 + & -(ciz*gmx-cix*gmz)*d31 + & -(gmmz*rimmx-gmmx*rimmz)*d32 + atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 + & -(cix*gmy-ciy*gmx)*d31 + & -(gmmx*rimmy-gmmy*rimmx)*d32 +cc********************************************************************** + astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy + & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz + & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy + & -ciy*rimy*gmmx-rimz*gmx*rimmz) + & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) + & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) + & -sd32*(gmmy*rimmz-rimmy*gmmz) + + astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz + & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy + & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx + & +gmz*rimy*rimmz-rimz*ciz*gmmy) + & -sd31*(gmcrim_x*(cix*rimy-gmz) + & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) + & -sd32*(-gmmx*rimmz+rimmx*gmmz) + + astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz + & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx + & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy + & +rimz*ciy*gmmy+rimz*gmx*rimmx) + & -sd31*(gmcrim_x*(cix*rimz+gmy) + & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) + & -sd32*(gmmx*rimmy-rimmx*gmmy) +c********************************************************************** + apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 + & -(gmmy*rimmz-gmmz*rimmy)*d34 + & +rix*d35 + apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 + & -(gmmz*rimmx-gmmx*rimmz)*d34 + & +riy*d35 + apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 + & -(gmmx*rimmy-gmmy*rimmx)*d34 + & +riz*d35 + endif + + if(i.ge.4) then + if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 + & .and.drim3.gt.0.0D0 + & .and.d_gmmcrimm3.gt.0.0D0) then + d40=1.0D0/(dg30*dgmm) + d41=g3gmm/(dg30*dgmm3) + d42=1.0D0/(dg30*drim) + d43=g3rim_/(dg30*drim3) + sd40=1.0D0/(dg30*d_gmmcrimm) + sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) + else + d40=0.0D0 + d41=0.0D0 + d42=0.0D0 + d43=0.0D0 + sd40=0.0D0 + sd41=0.0D0 + endif + atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 + & -(gmmy*rimmz-gmmz*rimmy)*d41 + atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 + & -(gmmz*rimmx-gmmx*rimmz)*d41 + atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 + & -(gmmx*rimmy-gmmy*rimmx)*d41 +cc********************************************************************** + astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y + & -g3z*rimmz*rimmx+rimmy**2*g3x) + & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) + & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) + + astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y + & -rimmx*rimmy*g3x+rimmz**2*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmy + & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmy) + +c & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) + + astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z + & +g3z*rimmx**2-rimmz*rimmy*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz + & +gmmcrimm_z*(rimmy**2+rimmx**2)) +c********************************************************************** + apm3x(i)=g3x*d42-rimx*d43 + apm3y(i)=g3y*d42-rimy*d43 + apm3z(i)=g3z*d42-rimz*d43 + endif + enddo +c******************************************************************************* + +c write(*,*) 'inside angvectors5' + +c do i=inb-2,inb + do i=1,0 + rimx=bx(i)-bx(i-1) + rimy=by(i)-by(i-1) + rimz=bz(i)-bz(i-1) + rimmx=bx(i-1)-bx(i-2) + rimmy=by(i-1)-by(i-2) + rimmz=bz(i-1)-bz(i-2) + rim3x=bx(i-2)-bx(i-3) + rim3y=by(i-2)-by(i-3) + rim3z=bz(i-2)-bz(i-3) + gmmx=rimmy*rimz-rimmz*rimy + gmmy=rimmz*rimx-rimmx*rimz + gmmz=rimmx*rimy-rimmy*rimx + g3x=rim3y*rimmz-rim3z*rimmy + g3y=rim3z*rimmx-rim3x*rimmz + g3z=rim3x*rimmy-rim3y*rimmx + + dg30=sqrt(g3x**2+g3y**2+g3z**2) + g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz + dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) + dgmm3=dgmm**3 + drim=dis(i-1,i) + drimm=dis(i-2,i-1) + drim3=drim**3 + g3rim_=g3x*rimx+g3y*rimy+g3z*rimz +cc********************************************************************** + gmmcrimm_x=gmmy*rimmz-gmmz*rimmy + gmmcrimm_y=gmmz*rimmx-gmmx*rimmz + gmmcrimm_z=gmmx*rimmy-gmmy*rimmx + d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) + d_gmmcrimm3=d_gmmcrimm**3 + gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y + & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y + + if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 + & .and.drim3.gt.0.0D0 + & .and.d_gmmcrimm3.gt.0.0D0) then + d40=1.0D0/(dg30*dgmm) + d41=g3gmm/(dg30*dgmm3) + d42=1.0D0/(dg30*drim) + d43=g3rim_/(dg30*drim3) + sd40=1.0D0/(dg30*d_gmmcrimm) + sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) + else + d40=0.0D0 + d41=0.0D0 + d42=0.0D0 + d43=0.0D0 + sd40=0.0D0 + sd41=0.0D0 + endif + atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 + & -(gmmy*rimmz-gmmz*rimmy)*d41 + atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 + & -(gmmz*rimmx-gmmx*rimmz)*d41 + atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 + & -(gmmx*rimmy-gmmy*rimmx)*d41 +cc********************************************************************** + astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y + & -g3z*rimmz*rimmx+rimmy**2*g3x) + & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) + & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) + + astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y + & -rimmx*rimmy*g3x+rimmz**2*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmy + & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) + + astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z + & +g3z*rimmx**2-rimmz*rimmy*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz + & +gmmcrimm_z*(rimmy**2+rimmx**2)) +cc********************************************************************** + apm3x(i)=g3x*d42-rimx*d43 + apm3y(i)=g3y*d42-rimy*d43 + apm3z(i)=g3z*d42-rimz*d43 + + if(i.le.inb-1) then + ip=i+1 + rix=bx(ip)-bx(i) + riy=by(ip)-by(i) + riz=bz(ip)-bz(i) + cix=bx(ip)-bx(i-1) + ciy=by(ip)-by(i-1) + ciz=bz(ip)-bz(i-1) + gmx=rimy*riz-rimz*riy + gmy=rimz*rix-rimx*riz + gmz=rimx*riy-rimy*rix + dgm=sqrt(gmx**2+gmy**2+gmz**2) + dgm3=dgm**3 + dri=dis(i,i+1) + dri3=dri**3 + gmmgm=gmmx*gmx+gmmy*gmy+gmmz+gmz + gmmr=gmmx*rix+gmmy*riy+gmmz*riz + gmcrim_x=gmy*rimz-gmz*rimy + gmcrim_y=gmz*rimx-gmx*rimz + gmcrim_z=gmx*rimy-gmy*rimx + d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) + d_gmcrim3=d_gmcrim**3 + gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy + & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy + + if(dgm3.gt.0.0D0.and. + & dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 + & .and.d_gmcrim3.gt.0.0D0) then + d30=1.0D0/(dgm*dgmm) + d31=gmmgm/(dgm3*dgmm) + d32=gmmgm/(dgm*dgmm3) + d33=1.0D0/(dgmm*dri) + d34=gmmr/(dgmm3*dri) + d35=gmmr/(dgmm*dri3) + sd30=1.0D0/(d_gmcrim*dgmm) + sd31=gmcrim__gmm/(d_gmcrim3*dgmm) + sd32=gmcrim__gmm/(d_gmcrim*dgmm3) + + else + d30=0.0D0 + d31=0.0D0 + d32=0.0D0 + d33=0.0D0 + d34=0.0D0 + d35=0.0D0 + sd30=0.0D0 + sd31=0.0D0 + sd32=0.0D0 + endif +cc********************************************************************** + atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 + & -(ciy*gmz-ciz*gmy)*d31 + & -(gmmy*rimmz-gmmz*rimmy)*d32 + atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 + & -(ciz*gmx-cix*gmz)*d31 + & -(gmmz*rimmx-gmmx*rimmz)*d32 + atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 + & -(cix*gmy-ciy*gmx)*d31 + & -(gmmx*rimmy-gmmy*rimmx)*d32 +cc********************************************************************** + astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy + & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz + & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy + & -ciy*rimy*gmmx-rimz*gmx*rimmz) + & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) + & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) + & -sd32*(gmmy*rimmz-rimmy*gmmz) + + astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz + & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy + & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx + & +gmz*rimy*rimmz-rimz*ciz*gmmy) + & -sd31*(gmcrim_x*(cix*rimy-gmz) + & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) + & -sd32*(-gmmx*rimmz+rimmx*gmmz) + + astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz + & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx + & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy + & +rimz*ciy*gmmy+rimz*gmx*rimmx) + & -sd31*(gmcrim_x*(cix*rimz+gmy) + & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) + & -sd32*(gmmx*rimmy-rimmx*gmmy) +cc********************************************************************** + apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 + & -(gmmy*rimmz-gmmz*rimmy)*d34 + & +rix*d35 + apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 + & -(gmmz*rimmx-gmmx*rimmz)*d34 + & +riy*d35 + apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 + & -(gmmx*rimmy-gmmy*rimmx)*d34 + & +riz*d35 + endif + +c write(*,*) 'inside angvectors6' + + if(i.eq.inb-2) then + ipp=i+2 + ripx=bx(ipp)-bx(ip) + ripy=by(ipp)-by(ip) + ripz=bz(ipp)-bz(ip) + cipx=bx(ipp)-bx(i) + cipy=by(ipp)-by(i) + cipz=bz(ipp)-bz(i) + gx=riy*ripz-riz*ripy + gy=riz*ripx-rix*ripz + gz=rix*ripy-riy*ripx + ggm=gmx*gx+gmy*gy+gmz*gz + gmrp=gmx*ripx+gmy*ripy+gmz*ripz + dg=sqrt(gx**2+gy**2+gz**2) + dg3=dg**3 + drip=dis(i+1,i+2) + gcr_x=gy*riz-gz*riy + gcr_y=gz*rix-gx*riz + gcr_z=gx*riy-gy*rix + d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) + d_gcr3=d_gcr**3 + gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy + & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy + if(dgm3.gt.0.0D0.and. + & dg3.gt.0.0D0.and.drip.gt.0.0D0.and.d_gcr3.gt.0.0D0 + & ) then + d20=1.0D0/(dg*dgm) + d21=ggm/(dgm3*dg) + d22=ggm/(dgm*dg3) + d23=1.0D0/(dgm*drip) + d24=gmrp/(dgm3*drip) + sd20=1.0D0/(d_gcr*dgm) + sd21=gcr__gm/(d_gcr3*dgm) + sd22=gcr__gm/(d_gcr*dgm3) + else + d20=0.0D0 + d21=0.0D0 + d22=0.0D0 + d23=0.0D0 + d24=0.0D0 + sd20=0.0D0 + sd21=0.0D0 + sd22=0.0D0 + endif + atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 + & -(ciy*gmz-ciz*gmy)*d21 + & +(ripy*gz-ripz*gy)*d22 + atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 + & -(ciz*gmx-cix*gmz)*d21 + & +(ripz*gx-ripx*gz)*d22 + atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 + & -(cix*gmy-ciy*gmx)*d21 + & +(ripx*gy-ripy*gx)*d22 +cc********************************************************************** + astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy + & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix + & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) + & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) + & +gcr_z*(-ripz*rix+gy)) + & -sd22*(-gmy*ciz+gmz*ciy) + + astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix + & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz + & +riz*ripz*gmy) + & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) + & -gcr_z*(ripz*riy+gx)) + & -sd22*(gmx*ciz-gmz*cix) + + astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz + & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy + & -riz*gx*cix) + & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) + & +gcr_z*(ripy*riy+ripx*rix)) + & -sd22*(-gmx*ciy+gmy*cix) +cc********************************************************************** +c + apmx(i)=(ciy*ripz-ripy*ciz)*d23 + & -(ciy*gmz-ciz*gmy)*d24 + apmy(i)=(ciz*ripx-ripz*cix)*d23 + & -(ciz*gmx-cix*gmz)*d24 + apmz(i)=(cix*ripy-ripx*ciy)*d23 + & -(cix*gmy-ciy*gmx)*d24 + + endif + enddo + + return + end +c END of angvectors +c------------------------------------------------------------------------------- +C--------------------------------------------------------------------------------- + subroutine sheetforce(nca,wshet) + implicit none +C JYLEE +c this should be matched with dfa.fcm + integer maxca + parameter(maxca=800) +cc********************************************************************** + integer nca + integer i,k + integer inb,nmax,iselect + +c real*8 dfaexp(15001) + + real*8 vbeta,vbetp,vbetm + real*8 shefx(maxca,12) + real*8 shefy(maxca,12),shefz(maxca,12) + real*8 shetfx(maxca),shetfy(maxca),shetfz(maxca) + real*8 vbet(maxca,maxca) + real*8 wshet(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + + common /sheca/ bx,by,bz + common /phys1/ inb,nmax,iselect + common /shef/ shefx,shefy,shefz + common /shee/ vbeta,vbet,vbetp,vbetm + common /shetf/ shetfx,shetfy,shetfz + + inb=nca + do i=1,inb + shetfx(i)=0.0D0 + shetfy(i)=0.0D0 + shetfz(i)=0.0D0 + enddo + + do k=1,12 + do i=1,inb + shefx(i,k)=0.0D0 + shefy(i,k)=0.0D0 + shefz(i,k)=0.0D0 + enddo + enddo + + call sheetene(nca,wshet) + call sheetforce1 + + 887 format(a,1x,i6,3x,f12.8) + 888 format(a,1x,i4,1x,i4,3x,f12.8) + 889 format(a,1x,i4,3x,f12.8) + !write(2,*) 'coord : ' + do i=1,inb + !write(2,887) 'bx:',i,bx(i) + !write(2,887) 'by:',i,by(i) + !write(2,887) 'bz:',i,bz(i) + enddo + !write(2,*) 'After sheetforce1' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce5 + + !write(2,*) 'After sheetforce5' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce6 + + !write(2,*) 'After sheetforce6' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce11 + + !write(2,*) 'After sheetforce11' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce12 + + !write(2,*) 'After sheetforce12' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + do i=1,inb + do k=1,12 + shetfx(i)=shetfx(i)+shefx(i,k) + shetfy(i)=shetfy(i)+shefy(i,k) + shetfz(i)=shetfz(i)+shefz(i,k) + enddo + enddo + !write(2,*) 'Beta Finished' + do i=1,inb + !write(2,889) 'shetfx : ',i,shetfx(i) + !write(2,889) 'shetfy : ',i,shetfy(i) + !write(2,889) 'shetfz : ',i,shetfz(i) + enddo + + return + end +C end sheetforce +c------------------------------------------------------------------------------- + subroutine sheetene(nca,wshet) + implicit none + integer maxca + parameter(maxca=800) +cc****************************************************************************** + +c real*8 dfaexp(15001) + real*8 dtmp1, dtmp2, dtmp3 + + real*8 vbet(maxca,maxca) + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 cph(maxca),cth(maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 ulcos(maxca) +cc********************************************************************** + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + real*8 sth(maxca) + real*8 wshet(maxca,maxca) + real*8 dp45, dm45, w_beta + real*8 c00, s00, ulnex, dnex, dca,dlhb,ulhb,dshe,dldhb,uldhb + integer nca + integer i,ip,ipp,j,jp,jpp,inb,nmax,iselect + real*8 uum, uup + real*8 vbeta,vbetp,vbetm,y,y1,y2,yshe1,yshe2,yy1,yy2 + + common /sheca/ bx,by,bz + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /coscos/ cph,cth + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + & c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shee/ vbeta,vbet,vbetp,vbetm + common /ulang/ ulcos +cc********************************************************************** + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + & astmmz,astm3x,astm3y,astm3z + common /sinsin/ sth + + real*8 r_pair_mat(maxca,maxca) +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m + common /beta_p/ r_pair_mat +C------------------------------------------------------------------------------- + r_pair_mat = 0.0d0 + do i=1,inb + do j=1,inb + r_pair_mat(i,j)=wshet(i,j) +c write(*,*) 'r_pair_mat :',i,j,r_pair_mat(i,j) + enddo + enddo +c stop +c + vbeta=0.0D0 + vbetp=0.0D0 + vbetm=0.0D0 + + do i=1,inb-7 + do j=i+4,inb-3 + ip=i+1 + ipp=i+2 + jp=j+1 + jpp=j+2 +cc********************************************************************** + y1=(cth(i)*c00+sth(i)*s00-1.0D0)**2 + & +(cth(j)*c00+sth(j)*s00-1.0D0)**2 + y1=-0.5d0*y1/dca + y2=(ulcos(i)-ulnex)**2+(ulcos(ip)-ulnex)**2 + & +(ulcos(j)-ulnex)**2+(ulcos(jp)-ulnex)**2 + y2=-0.5d0*y2/dnex + +cdebug y2=0 + + y=y1+y2 + +ci if(y.ge.-4) then +ci istrand(i,j)=1 +ci else +ci istrand(i,j)=0 +ci endif + +ci if(istrand(i,j).eq.1) then + + yy1=-0.5d0*(dis(ip,jp)-ulhb)**2/dlhb + yy2=-0.5d0*(dis(ipp,jpp)-ulhb)**2/dlhb + + + pin1(i,j)=(rx(ip,jp)*rx(ip,ipp)+ry(ip,jp)*ry(ip,ipp) + $ +rz(ip,jp)*rz(ip,ipp))/(dis(ip,jp)*dis(ip,ipp)) + pin2(i,j)=(rx(ip,jp)*rx(jp,jpp)+ry(ip,jp)*ry(jp,jpp) + $ +rz(ip,jp)*rz(jp,jpp))/(dis(ip,jp)*dis(jp,jpp)) + pin3(i,j)=(rx(ipp,jpp)*rx(ip,ipp)+ry(ipp,jpp)*ry(ip,ipp) + $ +rz(ipp,jpp)*rz(ip,ipp))/(dis(ipp,jpp)*dis(ip,ipp)) + pin4(i,j)=(rx(ipp,jpp)*rx(jp,jpp)+ry(ipp,jpp)*ry(jp,jpp) + $ +rz(ipp,jpp)*rz(jp,jpp))/(dis(ipp,jpp)*dis(jp,jpp)) + + yshe1=pin1(i,j)**2+pin2(i,j)**2 + yshe1=-0.5d0*yshe1/dshe + yshe2=pin3(i,j)**2+pin4(i,j)**2 + yshe2=-0.5d0*yshe2/dshe + +ci if((yshe1+yshe2).ge.-4) then +ci istrand_p(i,j)=1 +ci else +ci istrand_p(i,j)=0 +ci endif + + +C write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) +C write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) +C write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) +C write(*,*) 'dis(i,j):',i,j,dis(i,j) +C write(*,*) 'rx(ip,jp):',ip,jp,bx(ip),bx(jp),rx(ip,jp) +C write(*,*) 'rx(ip,ipp):',ip,ipp,bx(ip),bx(ipp),rx(ip,ipp) +C write(*,*) 'pin1:',pin1(i,j) +C write(*,*) 'pin2:',pin2(i,j) +C write(*,*) 'pin3:',pin3(i,j) +C write(*,*) 'pin4:',pin4(i,j) + +C write(*,*) 'y:',y +C write(*,*) 'yy1:',yy1 +C write(*,*) 'yy2:',yy2 +C write(*,*) 'yshe1:',yshe1 +C write(*,*) 'yshe2:',yshe2 +c + +ci if (istrand_p(i,j).eq.1) then + +cd yy1=0 +cd yy2=0 +cd yshe1=0 +cd yshe2=0 + dtmp1 = y+yy1+yshe1 + dtmp2 = y+yy2+yshe2 + dtmp3 = y+yy1+yy2+yshe1+yshe2 + +C write(*,*)'1', i,j,dtmp1,dtmp2,dtmp3 +C write(*,*)'2', y,yy1,yy2 +C write(*,*)'3', yshe1,yshe2 + +cc if (dtmp3.le.-35.0d0) then +c vbetap(i,j)=-dp45*exp(dtmp3) +cc vbetap(i,j)=0.0d0 +cc else +c vbetap(i,j)=-dp45*dfaexp(idint(-dtmp3*1000)+1) + vbetap(i,j)=-dp45*exp(dtmp3) +cc end if + +cc if (dtmp1.le.-35.0d0) then +c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) +cc vbetap1(i,j)=0.0d0 +cc else +c vbetap1(i,j)=-r_pair_mat(i+1,j+1) +c $ *dfaexp(idint(-dtmp1*1000)+1) + vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) +cc end if + +cc if (dtmp2.le.-35.0d0) then +C vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) +cc vbetap2(i,j)=0.0d0 +cc else +c vbetap2(i,j)=-r_pair_mat(i+2,j+2) +c $ *dfaexp(idint(-dtmp2*1000)+1) + vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) +cc end if + +c vbetap(i,j)=-dp45*exp(y+yy1+yy2+yshe1+yshe2) +c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(y+yy1+yshe1) +c vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(y+yy2+yshe2) + +! write(*,*) 'r_pair_mat>',i+1,j+1,r_pair_mat(i+1,j+1) +! write(*,*) 'r_pair_mat>',i+2,j+2,r_pair_mat(i+2,j+2) + +ci elseif (istrand_p(i,j).eq.0)then +ci vbetap(i,j)=0 +ci vbetap1(i,j)=0 +ci vbetap2(i,j)=0 +ci endif + + yy1=-0.5d0*(dis(ip,jpp)-ulhb)**2/dlhb + yy2=-0.5d0*(dis(ipp,jp)-ulhb)**2/dlhb + + pina1(i,j)=(rx(ip,jpp)*rx(ip,ipp)+ry(ip,jpp)*ry(ip,ipp) + $ +rz(ip,jpp)*rz(ip,ipp))/(dis(ip,jpp)*dis(ip,ipp)) + pina2(i,j)=(rx(ip,jpp)*rx(jp,jpp)+ry(ip,jpp)*ry(jp,jpp) + $ +rz(ip,jpp)*rz(jp,jpp))/(dis(ip,jpp)*dis(jp,jpp)) + pina3(i,j)=(rx(jp,ipp)*rx(ip,ipp)+ry(jp,ipp)*ry(ip,ipp) + $ +rz(jp,ipp)*rz(ip,ipp))/(dis(jp,ipp)*dis(ip,ipp)) + pina4(i,j)=(rx(jp,ipp)*rx(jp,jpp)+ry(jp,ipp)*ry(jp,jpp) + $ +rz(jp,ipp)*rz(jp,jpp))/(dis(jp,ipp)*dis(jp,jpp)) + + yshe1=pina1(i,j)**2+pina2(i,j)**2 + yshe1=-0.5d0*yshe1/dshe + yshe2=pina3(i,j)**2+pina4(i,j)**2 + yshe2=-0.5d0*yshe2/dshe + +ci if((yshe1+yshe2).ge.-4) then +ci istrand_m(i,j)=1 +ci else +ci istrand_m(i,j)=0 +ci endif + + +C write(*,*) 'pina1:',pina1(i,j) +C write(*,*) 'pina2:',pina2(i,j) +C write(*,*) 'pina3:',pina3(i,j) +C write(*,*) 'pina4:',pina4(i,j) +C write(*,*) 'yshe1:',yshe1 +C write(*,*) 'yshe2:',yshe2 +C write(*,*) 'dshe:',dshe + +ci if (istrand_m(i,j).eq.1) then + +cd yy1=0 +cd yy2=0 +cd yshe1=0 +cd yshe2=0 + + dtmp3=y+yy1+yy2+yshe1+yshe2 + dtmp1=y+yy1+yshe1 + dtmp2=y+yy2+yshe2 + +cc if(dtmp3 .le. -35.0d0) then +c vbetam(i,j)=-dm45*exp(dtmp3) +cc vbetam(i,j)=0.0d0 +cc else +c vbetam(i,j)=-dm45*dfaexp(idint(-dtmp3*1000)+1) + vbetam(i,j)=-dm45*exp(dtmp3) +cc end if + +cc if(dtmp1 .le. -35.0d0) then +c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) +cc vbetam1(i,j)=0.0d0 +cc else +c vbetam1(i,j)=-r_pair_mat(i+1,j+2) +c $ *dfaexp(idint(-dtmp1*1000)+1) + vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) +cc end if + +cc if(dtmp2.le.-35.0d0) then +c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) +cc vbetam2(i,j)=0.0d0 +cc else +c vbetam2(i,j)=-r_pair_mat(i+2,j+1) +c $ *dfaexp(idint(-dtmp2*1000)+1) + vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) +cc end if + +ci elseif (istrand_m(i,j).eq.0)then +ci vbetam(i,j)=0 +ci vbetam1(i,j)=0 +ci vbetam2(i,j)=0 +ci endif + + +c vbetam(i,j)=-dm45*exp(y+yy1+yy2+yshe1+yshe2) +c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(y+yy1+yshe1) +c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(y+yy2+yshe2) + +! write(*,*) 'r_pair_mat>',i+1,j+2,r_pair_mat(i+1,j+2) +! write(*,*) 'r_pair_mat>',i+2,j+1,r_pair_mat(i+2,j+1) + + uup = vbetap(i,j)+vbetap1(i,j)+vbetap2(i,j) + uum = vbetam(i,j)+vbetam1(i,j)+vbetam2(i,j) + +c write(*,*) 'uup,uum:', uup, uum + +c uup=vbetap1(i,j)+vbetap2(i,j) +c uum=vbetam1(i,j)+vbetam2(i,j) + + vbet(i,j)=uup+uum + vbetp=vbetp+uup + vbetm=vbetm+uum + vbeta=vbeta+vbet(i,j) + +ci elseif(istrand(i,j).eq.0)then +ci vbet(i,j)=0 +ci endif + +c write(*,*) 'uup,uum:',uup,uum +c write(*,*) 'vbetap(i,j):',vbetap(i,j) +c write(*,*) 'vbetap1(i,j):',vbetap1(i,j) +c write(*,*) 'vbetap2(i,j):',vbetap2(i,j) +c write(*,*) 'vbetam(i,j):',vbetam(i,j) +c write(*,*) 'vbetam1(i,j):',vbetam1(i,j) +c write(*,*) 'vbetam2(i,j):',vbetam2(i,j) +c write(*,*) 'uup:',uup +c write(*,*) 'uum:',uum +c write(*,*) 'vbetp:',vbetp +c write(*,*) 'vbetm:',vbetm +c write(*,*) 'vbet(i,j):',vbet(i,j) +c stop + + enddo + enddo + +! do i=1,inb-7 +! do j=i+4,inb-3 +! write(*,*) 'I,J:', i,j +! write(*,*) 'vbetap(i,j):',vbetap(i,j) +! write(*,*) 'vbetap1(i,j):',vbetap1(i,j) +! write(*,*) 'vbetap2(i,j):',vbetap2(i,j) +! write(*,*) 'vbetam(i,j):',vbetam(i,j) +! write(*,*) 'vbetam1(i,j):',vbetam1(i,j) +! write(*,*) 'vbetam2(i,j):',vbetam2(i,j) +! write(*,*) 'vbet(i,j):',vbet(i,j) +! enddo +! enddo + + return + end +c------------------------------------------------------------------------------- + subroutine sheetforce1 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbet(maxca,maxca) + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 cph(maxca),cth(maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12) + real*8 shefy(maxca,12),shefz(maxca,12) + real*8 atx(maxca),aty(maxca),atz(maxca) + real*8 atmx(maxca),atmy(maxca),atmz(maxca) + real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) + real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) + real*8 apx(maxca),apy(maxca),apz(maxca) + real*8 apmx(maxca),apmy(maxca),apmz(maxca) + real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) + real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) + real*8 ulcos(maxca) + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + real*8 sth(maxca) + real*8 w_beta,dp45, dm45 + real*8 vbeta, vbetp, vbetm + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect + + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /coscos/ cph,cth + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, + $ atmmz,atm3x,atm3y,atm3z + common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, + $ apmmz,apm3x,apm3y,apm3z + common /shef/ shefx,shefy,shefz + common /shee/ vbeta,vbet,vbetp,vbetm + common /ulang/ ulcos +c c********************************************************************** + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + $ astmmz,astm3x,astm3y,astm3z + common /sinsin/ sth +C-------------------------------------------------------------------------------- +c local variables + integer i,j,im3,imm,im,ip,ipp,jm,jmm,jm3,jp,jpp + real*8 c1,v1,cc1,dmm,dmm__,fx,fy,fz,c2,v2,dmm1 + real*8 c3,v3,cc2,cc3,dmm3,dmm3__,c4,v4,c7,v7,cc7,c8,v8,cc8 + real*8 c9,v9,cc9,dmm9,dmm9__,c10,v10,dmm2,dmm1__,dmm2_1,dmm2_2 + real*8 dmm7,dmm8,dmm7__,dmm8_1,dmm8_2 +C-------------------------------------------------------------------------------- + do i=4,inb-4 + im3=i-3 + imm=i-2 + im=i-1 + c1=(cth(im3)*c00+sth(im3)*s00-1)/dca + v1=0.0D0 + do j=i+1,inb-3 + v1=v1+vbet(im3,j) + enddo + cc1=(ulcos(imm)-ulnex)/dnex + dmm=cc1/(dis(imm,im)*dis(im,i)) + dmm__=cc1*ulcos(imm)/dis(im,i)**2 + fx=rx(imm,im)*dmm-rx(im,i)*dmm__ + fy=ry(imm,im)*dmm-ry(im,i)*dmm__ + fz=rz(imm,im)*dmm-rz(im,i)*dmm__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atm3x(i)*c00+astm3x(i)*s00)*c1 + fy=fy+(atm3y(i)*c00+astm3y(i)*s00)*c1 + fz=fz+(atm3z(i)*c00+astm3z(i)*s00)*c1 + shefx(i,1)=fx*v1 + shefy(i,1)=fy*v1 + shefz(i,1)=fz*v1 + enddo + + do i=3,inb-5 + imm=i-2 + im=i-1 + ip=i+1 + c2=(cth(imm)*c00+sth(imm)*s00-1)/dca + v2=0.0D0 + do j=i+2,inb-3 + v2=v2+vbet(imm,j) + enddo + cc1=(ulcos(imm)-ulnex)/dnex + cc2=(ulcos(im)-ulnex)/dnex + dmm1=cc1/(dis(imm,im)*dis(im,i)) + dmm2=cc2/(dis(im,i)*dis(i,ip)) + dmm1__=cc1*ulcos(imm)/dis(im,i)**2 + dmm2_1=cc2*ulcos(im)/dis(im,i)**2 + dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 +cc********************************************************************** + fx=rx(imm,im)*dmm1-rx(im,i)*dmm1__+rx(i,ip)*dmm2-rx(im,i)*dmm2 + $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2 + fy=ry(imm,im)*dmm1-ry(im,i)*dmm1__+ry(i,ip)*dmm2-ry(im,i)*dmm2 + $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2 + fz=rz(imm,im)*dmm1-rz(im,i)*dmm1__+rz(i,ip)*dmm2-rz(im,i)*dmm2 + $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2 +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmmx(i)*c00+astmmx(i)*s00)*c2 + fy=fy+(atmmy(i)*c00+astmmy(i)*s00)*c2 + fz=fz+(atmmz(i)*c00+astmmz(i)*s00)*c2 + shefx(i,2)=fx*v2 + shefy(i,2)=fy*v2 + shefz(i,2)=fz*v2 + enddo + do i=2,inb-6 + im=i-1 + ip=i+1 + ipp=i+2 + c3=(cth(im)*c00+sth(im)*s00-1)/dca + v3=0.0D0 + do j=i+3,inb-3 + v3=v3+vbet(im,j) + enddo + cc2=(ulcos(im)-ulnex)/dnex + cc3=(ulcos(i)-ulnex)/dnex + dmm2=cc2/(dis(im,i)*dis(i,ip)) + dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) + dmm2_1=cc2*ulcos(im)/dis(im,i)**2 + dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 + dmm3__=cc3*ulcos(i)/dis(i,ip)**2 + fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm2-rx(im,i)*dmm2 + $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2+rx(i,ip)*dmm3__ + fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm2-ry(im,i)*dmm2 + $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2+ry(i,ip)*dmm3__ + fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm2-rz(im,i)*dmm2 + $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2+rz(i,ip)*dmm3__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmx(i)*c00+astmx(i)*s00)*c3 + fy=fy+(atmy(i)*c00+astmy(i)*s00)*c3 + fz=fz+(atmz(i)*c00+astmz(i)*s00)*c3 + shefx(i,3)=fx*v3 + shefy(i,3)=fy*v3 + shefz(i,3)=fz*v3 + enddo + do i=1,inb-7 + ip=i+1 + ipp=i+2 + c4=(cth(i)*c00+sth(i)*s00-1)/dca + v4=0.0D0 + do j=i+4,inb-3 + v4=v4+vbet(i,j) + enddo + cc3=(ulcos(i)-ulnex)/dnex + dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) + dmm3__=cc3*ulcos(i)/dis(i,ip)**2 + fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm3__ + fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm3__ + fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm3__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atx(i)*c00+astx(i)*s00)*c4 + fy=fy+(aty(i)*c00+asty(i)*s00)*c4 + fz=fz+(atz(i)*c00+astz(i)*s00)*c4 + shefx(i,4)=fx*v4 + shefy(i,4)=fy*v4 + shefz(i,4)=fz*v4 + enddo + do j=8,inb + jm3=j-3 + jmm=j-2 + jm=j-1 + c7=(cth(jm3)*c00+sth(jm3)*s00-1)/dca + v7=0.0D0 + do i=1,j-7 + v7=v7+vbet(i,jm3) + enddo + cc7=(ulcos(jmm)-ulnex)/dnex + dmm=cc7/(dis(jmm,jm)*dis(jm,j)) + dmm__=cc7*ulcos(jmm)/dis(jm,j)**2 + fx=rx(jmm,jm)*dmm-rx(jm,j)*dmm__ + fy=ry(jmm,jm)*dmm-ry(jm,j)*dmm__ + fz=rz(jmm,jm)*dmm-rz(jm,j)*dmm__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atm3x(j)*c00+astm3x(j)*s00)*c7 + fy=fy+(atm3y(j)*c00+astm3y(j)*s00)*c7 + fz=fz+(atm3z(j)*c00+astm3z(j)*s00)*c7 + shefx(j,7)=fx*v7 + shefy(j,7)=fy*v7 + shefz(j,7)=fz*v7 + enddo + do j=7,inb-1 + jm=j-1 + jmm=j-2 + jp=j+1 + c8=(cth(jmm)*c00+sth(jmm)*s00-1)/dca + v8=0.0D0 + do i=1,j-6 + v8=v8+vbet(i,jmm) + enddo + cc7=(ulcos(jmm)-ulnex)/dnex + cc8=(ulcos(jm)-ulnex)/dnex + dmm7=cc7/(dis(jmm,jm)*dis(jm,j)) + dmm8=cc8/(dis(jm,j)*dis(j,jp)) + dmm7__=cc7*ulcos(jmm)/dis(jm,j)**2 + dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 + dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 + fx=rx(jmm,jm)*dmm7+rx(j,jp)*dmm8-rx(jm,j)*dmm8 + $ -rx(jm,j)*dmm7__-rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2 + fy=ry(jmm,jm)*dmm7+ry(j,jp)*dmm8-ry(jm,j)*dmm8 + $ -ry(jm,j)*dmm7__-ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2 + fz=rz(jmm,jm)*dmm7+rz(j,jp)*dmm8-rz(jm,j)*dmm8 + $ -rz(jm,j)*dmm7__-rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2 +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmmx(j)*c00+astmmx(j)*s00)*c8 + fy=fy+(atmmy(j)*c00+astmmy(j)*s00)*c8 + fz=fz+(atmmz(j)*c00+astmmz(j)*s00)*c8 + shefx(j,8)=fx*v8 + shefy(j,8)=fy*v8 + shefz(j,8)=fz*v8 + enddo + + do j=6,inb-2 + jm=j-1 + jp=j+1 + jpp=j+2 + c9=(cth(jm)*c00+sth(jm)*s00-1)/dca + v9=0.0D0 + do i=1,j-5 + v9=v9+vbet(i,jm) + enddo + cc8=(ulcos(jm)-ulnex)/dnex + cc9=(ulcos(j)-ulnex)/dnex + dmm8=cc8/(dis(jm,j)*dis(j,jp)) + dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) + dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 + dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 + dmm9__=cc9*ulcos(j)/dis(j,jp)**2 + fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm8-rx(jm,j)*dmm8 + $ -rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2+rx(j,jp)*dmm9__ + fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm8-ry(jm,j)*dmm8 + $ -ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2+ry(j,jp)*dmm9__ + fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm8-rz(jm,j)*dmm8 + $ -rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2+rz(j,jp)*dmm9__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmx(j)*c00+astmx(j)*s00)*c9 + fy=fy+(atmy(j)*c00+astmy(j)*s00)*c9 + fz=fz+(atmz(j)*c00+astmz(j)*s00)*c9 + shefx(j,9)=fx*v9 + shefy(j,9)=fy*v9 + shefz(j,9)=fz*v9 + enddo + + do j=5,inb-3 + jp=j+1 + jpp=j+2 + c10=(cth(j)*c00+sth(j)*s00-1)/dca + v10=0.0D0 + do i=1,j-4 + v10=v10+vbet(i,j) + enddo + cc9=(ulcos(j)-ulnex)/dnex + dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) + dmm9__=cc9*ulcos(j)/dis(j,jp)**2 + fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm9__ + fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm9__ + fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm9__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atx(j)*c00+astx(j)*s00)*c10 + fy=fy+(aty(j)*c00+asty(j)*s00)*c10 + fz=fz+(atz(j)*c00+astz(j)*s00)*c10 + shefx(j,10)=fx*v10 + shefy(j,10)=fy*v10 + shefz(j,10)=fz*v10 + enddo + + return + end +c---------------------------------------------------------------------------- + subroutine sheetforce5 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +c******************************************************************************** +c local variables + integer i,imm,im,jp,jpp,j + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z + real*8 y66x,y66y,y66z,yy6,yyy4,yyy5a,yyy5b + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b +c******************************************************************************** + do i=3,inb-5 + imm=i-2 + im=i-1 + do j=i+2,inb-3 + jp=j+1 + jpp=j+2 + +ci if(istrand(imm,j).eq.1 +ci & .and.(istrand_p(imm,j)+istrand_m(imm,j)).ge.1) then + + + yy1=-(dis(i,jpp)-ulhb)/dlhb + y1x=rx(jpp,i)/dis(i,jpp) + y1y=ry(jpp,i)/dis(i,jpp) + y1z=rz(jpp,i)/dis(i,jpp) + y11x=yy1*y1x + y11y=yy1*y1y + y11z=yy1*y1z + + yy33=1.0D0/(dis(im,jp)*dis(im,i)) + yyy3=pin1(imm,j)/(dis(im,i)**2) + yy3=-pin1(imm,j)/dshe + y3x=(yy33*rx(im,jp)-yyy3*rx(im,i))*yy3 + y3y=(yy33*ry(im,jp)-yyy3*ry(im,i))*yy3 + y3z=(yy33*rz(im,jp)-yyy3*rz(im,i))*yy3 + + yy44=1.0D0/(dis(i,jpp)*dis(im,i)) + yyy4a=pin3(imm,j)/(dis(i,jpp)**2) + yyy4b=pin3(imm,j)/(dis(im,i)**2) + yy4=-pin3(imm,j)/dshe + y4x=(yy44*(rx(i,jpp)-rx(im,i))+yyy4a*rx(i,jpp) + $ -yyy4b*rx(im,i))*yy4 + y4y=(yy44*(ry(i,jpp)-ry(im,i))+yyy4a*ry(i,jpp) + $ -yyy4b*ry(im,i))*yy4 + y4z=(yy44*(rz(i,jpp)-rz(im,i))+yyy4a*rz(i,jpp) + $ -yyy4b*rz(im,i))*yy4 + + + yy55=1.0D0/(dis(i,jpp)*dis(jp,jpp)) + yyy5=pin4(imm,j)/(dis(i,jpp)**2) + yy5=-pin4(imm,j)/dshe + y5x=(-yy55*rx(jp,jpp)+yyy5*rx(i,jpp))*yy5 + y5y=(-yy55*ry(jp,jpp)+yyy5*ry(i,jpp))*yy5 + y5z=(-yy55*rz(jp,jpp)+yyy5*rz(i,jpp))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y3x + sy1=y3y + sz1=y3z + sx2=y11x+y4x+y5x + sy2=y11y+y4y+y5y + sz2=y11z+y4z+y5z + + shefx(i,5)=shefx(i,5)-sx*vbetap(imm,j) + $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) + shefy(i,5)=shefy(i,5)-sy*vbetap(imm,j) + $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) + shefz(i,5)=shefz(i,5)-sz*vbetap(imm,j) + $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) + +! shefx(i,5)=shefx(i,5) +! $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) +! shefy(i,5)=shefy(i,5) +! $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) +! shefz(i,5)=shefz(i,5) +! $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) + + yy6=-(dis(i,jp)-uldhb)/dldhb + y6x=rx(jp,i)/dis(i,jp) + y6y=ry(jp,i)/dis(i,jp) + y6z=rz(jp,i)/dis(i,jp) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(im,jpp)*dis(im,i)) + yyy8=pina1(imm,j)/(dis(im,i)**2) + yy8=-pina1(imm,j)/dshe + y8x=(yy88*rx(im,jpp)-yyy8*rx(im,i))*yy8 + y8y=(yy88*ry(im,jpp)-yyy8*ry(im,i))*yy8 + y8z=(yy88*rz(im,jpp)-yyy8*rz(im,i))*yy8 + + yy99=1.0D0/(dis(jp,i)*dis(im,i)) + yyy9a=pina3(imm,j)/(dis(jp,i)**2) + yyy9b=pina3(imm,j)/(dis(im,i)**2) + yy9=-pina3(imm,j)/dshe + y9x=(yy99*(rx(jp,i)+rx(im,i))-yyy9a*rx(jp,i) + $ -yyy9b*rx(im,i))*yy9 + y9y=(yy99*(ry(jp,i)+ry(im,i))-yyy9a*ry(jp,i) + $ -yyy9b*ry(im,i))*yy9 + y9z=(yy99*(rz(jp,i)+rz(im,i))-yyy9a*rz(jp,i) + $ -yyy9b*rz(im,i))*yy9 + + yy1010=1.0D0/(dis(jp,i)*dis(jp,jpp)) + yyy10=pina4(imm,j)/(dis(jp,i)**2) + yy10=-pina4(imm,j)/dshe + y10x=(yy1010*rx(jp,jpp)-yyy10*rx(jp,i))*yy10 + y10y=(yy1010*ry(jp,jpp)-yyy10*ry(jp,i))*yy10 + y10z=(yy1010*rz(jp,jpp)-yyy10*rz(jp,i))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y8x + sy1=y8y + sz1=y8z + sx2=y66x+y9x+y10x + sy2=y66y+y9y+y10y + sz2=y66z+y9z+y10z + + shefx(i,5)=shefx(i,5)-sx*vbetam(imm,j) + $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) + shefy(i,5)=shefy(i,5)-sy*vbetam(imm,j) + $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) + shefz(i,5)=shefz(i,5)-sz*vbetam(imm,j) + $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) + +! shefx(i,5)=shefx(i,5) +! $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) +! shefy(i,5)=shefy(i,5) +! $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) +! shefz(i,5)=shefz(i,5) +! $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) + +ci endif + + enddo + enddo + + return + end +c--------------------------------------------------------------------------c + subroutine sheetforce6 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +cc********************************************************************** +C local variables + integer i,imm,im,jp,jpp,j,ip + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b,yyy4 + real*8 yyy3a,yyy3b,y66z,yy6,yyy5a,yyy5b +C******************************************************************************** + do i=2,inb-6 + ip=i+1 + im=i-1 + do j=i+3,inb-3 + jp=j+1 + jpp=j+2 + +ci if(istrand(im,j).eq.1 +ci & .and.(istrand_p(im,j)+istrand_m(im,j)).ge.1) then + + + yy1=-(dis(i,jp)-ulhb)/dlhb + y1x=rx(jp,i)/dis(i,jp) + y1y=ry(jp,i)/dis(i,jp) + y1z=rz(jp,i)/dis(i,jp) + y11x=yy1*y1x + y11y=yy1*y1y + y11z=yy1*y1z + + yy33=1.0D0/(dis(i,jp)*dis(i,ip)) + yyy3a=pin1(im,j)/(dis(i,jp)**2) + yyy3b=pin1(im,j)/(dis(i,ip)**2) + yy3=-pin1(im,j)/dshe + y3x=(-yy33*(rx(i,ip)+rx(i,jp))+yyy3a*rx(i,jp) + $ +yyy3b*rx(i,ip))*yy3 + y3y=(-yy33*(ry(i,ip)+ry(i,jp))+yyy3a*ry(i,jp) + $ +yyy3b*ry(i,ip))*yy3 + y3z=(-yy33*(rz(i,ip)+rz(i,jp))+yyy3a*rz(i,jp) + $ +yyy3b*rz(i,ip))*yy3 + + yy44=1.0D0/(dis(i,jp)*dis(jp,jpp)) + yyy4=pin2(im,j)/(dis(i,jp)**2) + yy4=-pin2(im,j)/dshe + y4x=(-yy44*rx(jp,jpp)+yyy4*rx(i,jp))*yy4 + y4y=(-yy44*ry(jp,jpp)+yyy4*ry(i,jp))*yy4 + y4z=(-yy44*rz(jp,jpp)+yyy4*rz(i,jp))*yy4 + + yy55=1.0D0/(dis(ip,jpp)*dis(i,ip)) + yyy5=pin3(im,j)/(dis(i,ip)**2) + yy5=-pin3(im,j)/dshe + y5x=(-yy55*rx(ip,jpp)+yyy5*rx(i,ip))*yy5 + y5y=(-yy55*ry(ip,jpp)+yyy5*ry(i,ip))*yy5 + y5z=(-yy55*rz(ip,jpp)+yyy5*rz(i,ip))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y11x+y3x+y4x + sy1=y11y+y3y+y4y + sz1=y11z+y3z+y4z + sx2=y5x + sy2=y5y + sz2=y5z + + shefx(i,6)=shefx(i,6)-sx*vbetap(im,j) + $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) + shefy(i,6)=shefy(i,6)-sy*vbetap(im,j) + $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) + shefz(i,6)=shefz(i,6)-sz*vbetap(im,j) + $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) +! shefx(i,6)=shefx(i,6) +! $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) +! shefy(i,6)=shefy(i,6) +! $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) +! shefz(i,6)=shefz(i,6) +! $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) + + yy6=-(dis(jpp,i)-uldhb)/dldhb + y6x=rx(jpp,i)/dis(jpp,i) + y6y=ry(jpp,i)/dis(jpp,i) + y6z=rz(jpp,i)/dis(jpp,i) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(i,jpp)*dis(i,ip)) + yyy8a=pina1(im,j)/(dis(i,jpp)**2) + yyy8b=pina1(im,j)/(dis(i,ip)**2) + yy8=-pina1(im,j)/dshe + y8x=(-yy88*(rx(i,jpp)+rx(i,ip))+yyy8a*rx(i,jpp) + $ +yyy8b*rx(i,ip))*yy8 + y8y=(-yy88*(ry(i,jpp)+ry(i,ip))+yyy8a*ry(i,jpp) + $ +yyy8b*ry(i,ip))*yy8 + y8z=(-yy88*(rz(i,jpp)+rz(i,ip))+yyy8a*rz(i,jpp) + $ +yyy8b*rz(i,ip))*yy8 + + yy99=1.0D0/(dis(i,jpp)*dis(jp,jpp)) + yyy9=pina2(im,j)/(dis(i,jpp)**2) + yy9=-pina2(im,j)/dshe + y9x=(-yy99*rx(jp,jpp)+yyy9*rx(i,jpp))*yy9 + y9y=(-yy99*ry(jp,jpp)+yyy9*ry(i,jpp))*yy9 + y9z=(-yy99*rz(jp,jpp)+yyy9*rz(i,jpp))*yy9 + + yy1010=1.0D0/(dis(jp,ip)*dis(i,ip)) + yyy10=pina3(im,j)/(dis(i,ip)**2) + yy10=-pina3(im,j)/dshe + y10x=(-yy1010*rx(jp,ip)+yyy10*rx(i,ip))*yy10 + y10y=(-yy1010*ry(jp,ip)+yyy10*ry(i,ip))*yy10 + y10z=(-yy1010*rz(jp,ip)+yyy10*rz(i,ip))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y66x+y8x+y9x + sy1=y66y+y8y+y9y + sz1=y66z+y8z+y9z + sx2=y10x + sy2=y10y + sz2=y10z + + shefx(i,6)=shefx(i,6)-sx*vbetam(im,j) + $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) + shefy(i,6)=shefy(i,6)-sy*vbetam(im,j) + $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) + shefz(i,6)=shefz(i,6)-sz*vbetam(im,j) + $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) + +! shefx(i,6)=shefx(i,6) +! $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) +! shefy(i,6)=shefy(i,6) +! $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) +! shefz(i,6)=shefz(i,6) +! $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) + +ci endif + + enddo + enddo + + return + end +c----------------------------------------------------------------------- + subroutine sheetforce11 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +C******************************************************************************** +C local variables + integer j,jm,jmm,ip,i,ipp + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy4,yyy5a,yyy5b,yy6 + real*8 yyy9a,yyy9b,y5z,y66z,y9z,yyy8 +C******************************************************************************** + + do j=7,inb-1 + jm=j-1 + jmm=j-2 + do i=1,j-6 + ip=i+1 + ipp=i+2 + +ci if(istrand(i,jmm).eq.1 +ci & .and.(istrand_p(i,jmm)+istrand_m(i,jmm)).ge.1) then + + + yy1=-(dis(ipp,j)-ulhb)/dlhb + y1x=rx(ipp,j)/dis(ipp,j) + y1y=ry(ipp,j)/dis(ipp,j) + y1z=rz(ipp,j)/dis(ipp,j) + y11x=yy1*y1x + y11y=yy1*y1y + y11z=yy1*y1z + + yy33=1.0D0/(dis(ip,jm)*dis(jm,j)) + yyy3=pin2(i,jmm)/(dis(jm,j)**2) + yy3=-pin2(i,jmm)/dshe + y3x=(yy33*rx(ip,jm)-yyy3*rx(jm,j))*yy3 + y3y=(yy33*ry(ip,jm)-yyy3*ry(jm,j))*yy3 + y3z=(yy33*rz(ip,jm)-yyy3*rz(jm,j))*yy3 + + yy44=1.0D0/(dis(ipp,j)*dis(ip,ipp)) + yyy4=pin3(i,jmm)/(dis(ipp,j)**2) + yy4=-pin3(i,jmm)/dshe + y4x=(yy44*rx(ip,ipp)-yyy4*rx(ipp,j))*yy4 + y4y=(yy44*ry(ip,ipp)-yyy4*ry(ipp,j))*yy4 + y4z=(yy44*rz(ip,ipp)-yyy4*rz(ipp,j))*yy4 + + yy55=1.0D0/(dis(ipp,j)*dis(jm,j)) + yyy5a=pin4(i,jmm)/(dis(ipp,j)**2) + yyy5b=pin4(i,jmm)/(dis(jm,j)**2) + yy5=-pin4(i,jmm)/dshe + y5x=(yy55*(rx(jm,j)+rx(ipp,j))-yyy5a*rx(ipp,j) + $ -yyy5b*rx(jm,j))*yy5 + y5y=(yy55*(ry(jm,j)+ry(ipp,j))-yyy5a*ry(ipp,j) + $ -yyy5b*ry(jm,j))*yy5 + y5z=(yy55*(rz(jm,j)+rz(ipp,j))-yyy5a*rz(ipp,j) + $ -yyy5b*rz(jm,j))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y3x + sy1=y3y + sz1=y3z + sx2=y11x+y4x+y5x + sy2=y11y+y4y+y5y + sz2=y11z+y4z+y5z + + shefx(j,11)=shefx(j,11)-sx*vbetap(i,jmm) + $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) + shefy(j,11)=shefy(j,11)-sy*vbetap(i,jmm) + $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) + shefz(j,11)=shefz(j,11)-sz*vbetap(i,jmm) + $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) + +! shefx(j,11)=shefx(j,11) +! $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) +! shefy(j,11)=shefy(j,11) +! $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) +! shefz(j,11)=shefz(j,11) +! $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) + + yy6=-(dis(ip,j)-uldhb)/dldhb + y6x=rx(ip,j)/dis(ip,j) + y6y=ry(ip,j)/dis(ip,j) + y6z=rz(ip,j)/dis(ip,j) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(ip,j)*dis(ip,ipp)) + yyy8=pina1(i,jmm)/(dis(ip,j)**2) + yy8=-pina1(i,jmm)/dshe + y8x=(yy88*rx(ip,ipp)-yyy8*rx(ip,j))*yy8 + y8y=(yy88*ry(ip,ipp)-yyy8*ry(ip,j))*yy8 + y8z=(yy88*rz(ip,ipp)-yyy8*rz(ip,j))*yy8 + + yy99=1.0D0/(dis(ip,j)*dis(jm,j)) + yyy9a=pina2(i,jmm)/(dis(ip,j)**2) + yyy9b=pina2(i,jmm)/(dis(jm,j)**2) + yy9=-pina2(i,jmm)/dshe + y9x=(yy99*(rx(jm,j)+rx(ip,j))-yyy9a*rx(ip,j) + $ -yyy9b*rx(jm,j))*yy9 + y9y=(yy99*(ry(jm,j)+ry(ip,j))-yyy9a*ry(ip,j) + $ -yyy9b*ry(jm,j))*yy9 + y9z=(yy99*(rz(jm,j)+rz(ip,j))-yyy9a*rz(ip,j) + $ -yyy9b*rz(jm,j))*yy9 + + yy1010=1.0D0/(dis(jm,ipp)*dis(jm,j)) + yyy10=pina4(i,jmm)/(dis(jm,j)**2) + yy10=-pina4(i,jmm)/dshe + y10x=(yy1010*rx(jm,ipp)-yyy10*rx(jm,j))*yy10 + y10y=(yy1010*ry(jm,ipp)-yyy10*ry(jm,j))*yy10 + y10z=(yy1010*rz(jm,ipp)-yyy10*rz(jm,j))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y66x+y8x+y9x + sy1=y66y+y8y+y9y + sz1=y66z+y8z+y9z + sx2=y10x + sy2=y10y + sz2=y10z + + shefx(j,11)=shefx(j,11)-sx*vbetam(i,jmm) + $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) + shefy(j,11)=shefy(j,11)-sy*vbetam(i,jmm) + $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) + shefz(j,11)=shefz(j,11)-sz*vbetam(i,jmm) + $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) + +! shefx(j,11)=shefx(j,11) +! $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) +! shefy(j,11)=shefy(j,11) +! $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) +! shefz(j,11)=shefz(j,11) +! $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) + +ci endif + + enddo + enddo + + return + end +c----------------------------------------------------------------------- + subroutine sheetforce12 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +cc********************************************************************** +C local variables + integer j,jm,jmm,ip,i,ipp,jp + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y,y66z + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy10a,yyy10b,yy6,yyy8 +!c*************************************************************************c + do j=6,inb-2 + jp=j+1 + jm=j-1 + do i=1,j-5 + ip=i+1 + ipp=i+2 + +ci if(istrand(i,jm).eq.1 +ci & .and.(istrand_p(i,jm)+istrand_m(i,jm)).ge.1) then + + + yy1=-(dis(ip,j)-ulhb)/dlhb + y1x=rx(ip,j)/dis(ip,j) + y1y=ry(ip,j)/dis(ip,j) + y1z=rz(ip,j)/dis(ip,j) + y11x=y1x*yy1 + y11y=y1y*yy1 + y11z=y1z*yy1 + + yy33=1.0D0/(dis(ip,j)*dis(ip,ipp)) + yyy3=pin1(i,jm)/(dis(ip,j)**2) + yy3=-pin1(i,jm)/dshe + y3x=(yy33*rx(ip,ipp)-yyy3*rx(ip,j))*yy3 + y3y=(yy33*ry(ip,ipp)-yyy3*ry(ip,j))*yy3 + y3z=(yy33*rz(ip,ipp)-yyy3*rz(ip,j))*yy3 + yy44=1.0D0/(dis(ip,j)*dis(j,jp)) + + yyy4a=pin2(i,jm)/(dis(ip,j)**2) + yyy4b=pin2(i,jm)/(dis(j,jp)**2) + yy4=-pin2(i,jm)/dshe + y4x=(yy44*(rx(j,jp)-rx(ip,j))-yyy4a*rx(ip,j) + $ +yyy4b*rx(j,jp))*yy4 + y4y=(yy44*(ry(j,jp)-ry(ip,j))-yyy4a*ry(ip,j) + $ +yyy4b*ry(j,jp))*yy4 + y4z=(yy44*(rz(j,jp)-rz(ip,j))-yyy4a*rz(ip,j) + $ +yyy4b*rz(j,jp))*yy4 + + yy55=1.0D0/(dis(ipp,jp)*dis(j,jp)) + yyy5=pin4(i,jm)/(dis(j,jp)**2) + yy5=-pin4(i,jm)/dshe + y5x=(-yy55*rx(ipp,jp)+yyy5*rx(j,jp))*yy5 + y5y=(-yy55*ry(ipp,jp)+yyy5*ry(j,jp))*yy5 + y5z=(-yy55*rz(ipp,jp)+yyy5*rz(j,jp))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y11x+y3x+y4x + sy1=y11y+y3y+y4y + sz1=y11z+y3z+y4z + sx2=y5x + sy2=y5y + sz2=y5z + + shefx(j,12)=shefx(j,12)-sx*vbetap(i,jm) + $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) + shefy(j,12)=shefy(j,12)-sy*vbetap(i,jm) + $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) + shefz(j,12)=shefz(j,12)-sz*vbetap(i,jm) + $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) + +! shefx(j,12)=shefx(j,12) +! $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) +! shefy(j,12)=shefy(j,12) +! $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) +! shefz(j,12)=shefz(j,12) +! $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) + + yy6=-(dis(ipp,j)-uldhb)/dldhb + y6x=rx(ipp,j)/dis(ipp,j) + y6y=ry(ipp,j)/dis(ipp,j) + y6z=rz(ipp,j)/dis(ipp,j) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(ip,jp)*dis(j,jp)) + yyy8=pina2(i,jm)/(dis(j,jp)**2) + yy8=-pina2(i,jm)/dshe + y8x=(-yy88*rx(ip,jp)+yyy8*rx(j,jp))*yy8 + y8y=(-yy88*ry(ip,jp)+yyy8*ry(j,jp))*yy8 + y8z=(-yy88*rz(ip,jp)+yyy8*rz(j,jp))*yy8 + + yy99=1.0D0/(dis(j,ipp)*dis(ip,ipp)) + yyy9=pina3(i,jm)/(dis(j,ipp)**2) + yy9=-pina3(i,jm)/dshe + y9x=(-yy99*rx(ip,ipp)+yyy9*rx(j,ipp))*yy9 + y9y=(-yy99*ry(ip,ipp)+yyy9*ry(j,ipp))*yy9 + y9z=(-yy99*rz(ip,ipp)+yyy9*rz(j,ipp))*yy9 + + yy1010=1.0D0/(dis(j,ipp)*dis(j,jp)) + yyy10a=pina4(i,jm)/(dis(j,ipp)**2) + yyy10b=pina4(i,jm)/(dis(j,jp)**2) + yy10=-pina4(i,jm)/dshe + y10x=(-yy1010*(rx(j,ipp)+rx(j,jp))+yyy10a*rx(j,ipp) + $ +yyy10b*rx(j,jp))*yy10 + y10y=(-yy1010*(ry(j,ipp)+ry(j,jp))+yyy10a*ry(j,ipp) + $ +yyy10b*ry(j,jp))*yy10 + y10z=(-yy1010*(rz(j,ipp)+rz(j,jp))+yyy10a*rz(j,ipp) + $ +yyy10b*rz(j,jp))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y8x + sy1=y8y + sz1=y8z + sx2=y66x+y9x+y10x + sy2=y66y+y9y+y10y + sz2=y66z+y9z+y10z + + shefx(j,12)=shefx(j,12)-sx*vbetam(i,jm) + $ -sx1*vbetam1(i,jm)-sx2*vbetam2(i,jm) + shefy(j,12)=shefy(j,12)-sy*vbetam(i,jm) + $ -sy1*vbetam1(i,jm)-sy2*vbetam2(i,jm) + shefz(j,12)=shefz(j,12)-sz*vbetam(i,jm) + $ -sz1*vbetam1(i,jm)-sz2*vbetam2(i,jm) + +ci endif + + ENDDO + ENDDO + + RETURN + END +C=============================================================================== diff --git a/source/cluster/wham/src/energy_p_new.F b/source/cluster/wham/src/energy_p_new.F index 636f983..471eb5d 100644 --- a/source/cluster/wham/src/energy_p_new.F +++ b/source/cluster/wham/src/energy_p_new.F @@ -20,6 +20,8 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' + include 'COMMON.CONTROL' + double precision fact(5) cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot cd print *,'nnt=',nnt,' nct=',nct @@ -100,6 +102,26 @@ c print *,ecorr,ecorr5,ecorr6,eturn6 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif + +c write(iout,*) "TEST_ENE",constr_homology + if (constr_homology.ge.1) then + call e_modeller(ehomology_constr) + else + ehomology_constr=0.0d0 + endif +c write(iout,*) "TEST_ENE",ehomology_constr + +C BARTEK for dfa test! + if (wdfa_dist.gt.0) call edfad(edfadis) +c print*, 'edfad is finished!', edfadis + if (wdfa_tor.gt.0) call edfat(edfator) +c print*, 'edfat is finished!', edfator + if (wdfa_nei.gt.0) call edfan(edfanei) +c print*, 'edfan is finished!', edfanei + if (wdfa_beta.gt.0) call edfab(edfabet) +c print*, 'edfab is finished!', edfabet + + C call multibody(ecorr) C C Sum the energies @@ -111,7 +133,9 @@ C & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr + & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei + & +wdfa_beta*edfabet #else etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1) & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc @@ -119,7 +143,9 @@ C & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr + & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei + & +wdfa_beta*edfabet #endif energia(0)=etot energia(1)=evdw @@ -152,6 +178,11 @@ C energia(18)=estr energia(19)=esccor energia(20)=edihcnstr + energia(21)=ehomology_constr + energia(22)=edfadis + energia(23)=edfator + energia(24)=edfanei + energia(25)=edfabet cc if (dyn_ss) call dyn_set_nss c detecting NaNQ i=0 @@ -182,7 +213,11 @@ C & wcorr5*fact(4)*gradcorr5(j,i)+ & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ - & wsccor*fact(2)*gsccorc(j,i) + & wsccor*fact(2)*gsccorc(j,i)+ + & wdfa_dist*gdfad(j,i)+ + & wdfa_tor*gdfat(j,i)+ + & wdfa_nei*gdfan(j,i)+ + & wdfa_beta*gdfab(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i) @@ -200,7 +235,11 @@ C & wcorr5*fact(4)*gradcorr5(j,i)+ & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ - & wsccor*fact(2)*gsccorc(j,i) + & wsccor*fact(2)*gsccorc(j,i)+ + & wdfa_dist*gdfad(j,i)+ + & wdfa_tor*gdfat(j,i)+ + & wdfa_nei*gdfan(j,i)+ + & wdfa_beta*gdfab(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i) @@ -263,6 +302,11 @@ C------------------------------------------------------------------------ esccor=energia(19) edihcnstr=energia(20) estr=energia(18) + ehomology_constr=energia(21) + edfadis=energia(22) + edfator=energia(23) + edfanei=energia(24) + edfabet=energia(25) #ifdef SPLITELE write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1, & wvdwpp, @@ -271,7 +315,9 @@ C------------------------------------------------------------------------ & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), - & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot + & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss, + & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet, + & wdfa_beta,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -293,7 +339,12 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/ + & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/ + & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/ + & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/ & 'ETOT= ',1pE16.6,' (total)') #else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond, @@ -302,7 +353,9 @@ C------------------------------------------------------------------------ & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2), & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3), & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor, - & edihcnstr,ebr*nss,etot + & edihcnstr,ehomology_constr,ebr*nss, + & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet, + & wdfa_beta,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -323,7 +376,12 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/ + & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/ + & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/ + & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/ & 'ETOT= ',1pE16.6,' (total)') #endif return @@ -3008,6 +3066,600 @@ C enddo return end + +C-------------------------------------------------------------------------- + + +c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA + subroutine e_modeller(ehomology_constr) + implicit real*8 (a-h,o-z) + + include 'DIMENSIONS' + + integer nnn, i, j, k, ki, irec, l + integer katy, odleglosci, test7 + real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template) + real*8 distance(max_template),distancek(max_template), + & min_odl,godl(max_template),dih_diff(max_template) + +c +c FP - 30/10/2014 Temporary specifications for homology restraints +c + double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta, + & sgtheta + double precision, dimension (maxres) :: guscdiff,usc_diff + double precision, dimension (max_template) :: + & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3, + & theta_diff + + include 'COMMON.SBRIDGE' + include 'COMMON.CHAIN' + include 'COMMON.GEO' + include 'COMMON.DERIV' + include 'COMMON.LOCAL' + include 'COMMON.INTERACT' + include 'COMMON.VAR' + include 'COMMON.IOUNITS' + include 'COMMON.CONTROL' + include 'COMMON.HOMRESTR' +c + include 'COMMON.SETUP' + include 'COMMON.NAMES' + + do i=1,19 + distancek(i)=9999999.9 + enddo + + odleg=0.0d0 + +c Pseudo-energy and gradient from homology restraints (MODELLER-like +c function) +C AL 5/2/14 - Introduce list of restraints +c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d +#ifdef DEBUG + write(iout,*) "------- dist restrs start -------" + write (iout,*) "link_start_homo",link_start_homo, + & " link_end_homo",link_end_homo +#endif + do ii = link_start_homo,link_end_homo + i = ires_homo(ii) + j = jres_homo(ii) + dij=dist(i,j) +c write (iout,*) "dij(",i,j,") =",dij + do k=1,constr_homology + distance(k)=odl(k,ii)-dij +c write (iout,*) "distance(",k,") =",distance(k) +c +c For Gaussian-type Urestr +c + distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument +c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii) +c write (iout,*) "distancek(",k,") =",distancek(k) +c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii) +c +c For Lorentzian-type Urestr +c + if (waga_dist.lt.0.0d0) then + sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii)) + distancek(k)=distance(k)**2/(sigma_odlir(k,ii)* + & (distance(k)**2+sigma_odlir(k,ii)**2)) + endif + enddo + + min_odl=minval(distancek) +c write (iout,* )"min_odl",min_odl +#ifdef DEBUG + write (iout,*) "ij dij",i,j,dij + write (iout,*) "distance",(distance(k),k=1,constr_homology) + write (iout,*) "distancek",(distancek(k),k=1,constr_homology) + write (iout,* )"min_odl",min_odl +#endif + odleg2=0.0d0 + do k=1,constr_homology +c Nie wiem po co to liczycie jeszcze raz! +c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/ +c & (2*(sigma_odl(i,j,k))**2)) + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + godl(k)=dexp(-distancek(k)+min_odl) + odleg2=odleg2+godl(k) +c +c For Lorentzian-type Urestr +c + else + odleg2=odleg2+distancek(k) + endif + +ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3, +ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=", +ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1), +ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k) + + enddo +c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents +c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps +#ifdef DEBUG + write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents + write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps +#endif + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + odleg=odleg-dLOG(odleg2/constr_homology)+min_odl +c +c For Lorentzian-type Urestr +c + else + odleg=odleg+odleg2/constr_homology + endif +c +#ifdef GRAD +c write (iout,*) "odleg",odleg ! sum of -ln-s +c Gradient +c +c For Gaussian-type Urestr +c + if (waga_dist.ge.0.0d0) sum_godl=odleg2 + sum_sgodl=0.0d0 + do k=1,constr_homology +c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) +c & *waga_dist)+min_odl +c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist +c + if (waga_dist.ge.0.0d0) then +c For Gaussian-type Urestr +c + sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd +c +c For Lorentzian-type Urestr +c + else + sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+ + & sigma_odlir(k,ii)**2)**2) + endif + sum_sgodl=sum_sgodl+sgodl + +c sgodl2=sgodl2+sgodl +c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1" +c write(iout,*) "constr_homology=",constr_homology +c write(iout,*) i, j, k, "TEST K" + enddo + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + grad_odl3=waga_homology(iset)*waga_dist + & *sum_sgodl/(sum_godl*dij) +c +c For Lorentzian-type Urestr +c + else +c Original grad expr modified by analogy w Gaussian-type Urestr grad +c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl + grad_odl3=-waga_homology(iset)*waga_dist* + & sum_sgodl/(constr_homology*dij) + endif +c +c grad_odl3=sum_sgodl/(sum_godl*dij) + + +c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2" +c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2), +c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) + +ccc write(iout,*) godl, sgodl, grad_odl3 + +c grad_odl=grad_odl+grad_odl3 + + do jik=1,3 + ggodl=grad_odl3*(c(jik,i)-c(jik,j)) +ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1)) +ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl, +ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) + ghpbc(jik,i)=ghpbc(jik,i)+ggodl + ghpbc(jik,j)=ghpbc(jik,j)-ggodl +ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl, +ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) +c if (i.eq.25.and.j.eq.27) then +c write(iout,*) "jik",jik,"i",i,"j",j +c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl +c write(iout,*) "grad_odl3",grad_odl3 +c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j) +c write(iout,*) "ggodl",ggodl +c write(iout,*) "ghpbc(",jik,i,")", +c & ghpbc(jik,i),"ghpbc(",jik,j,")", +c & ghpbc(jik,j) +c endif + enddo +#endif +ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=", +ccc & dLOG(odleg2),"-odleg=", -odleg + + enddo ! ii-loop for dist +#ifdef DEBUG + write(iout,*) "------- dist restrs end -------" +c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or. +c & waga_d.eq.1.0d0) call sum_gradient +#endif +c Pseudo-energy and gradient from dihedral-angle restraints from +c homology templates +c write (iout,*) "End of distance loop" +c call flush(iout) + kat=0.0d0 +c write (iout,*) idihconstr_start_homo,idihconstr_end_homo +#ifdef DEBUG + write(iout,*) "------- dih restrs start -------" + do i=idihconstr_start_homo,idihconstr_end_homo + write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg) + enddo +#endif + do i=idihconstr_start_homo,idihconstr_end_homo + kat2=0.0d0 +c betai=beta(i,i+1,i+2,i+3) + betai = phi(i+3) +c write (iout,*) "betai =",betai + do k=1,constr_homology + dih_diff(k)=pinorm(dih(k,i)-betai) +c write (iout,*) "dih_diff(",k,") =",dih_diff(k) +c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)= +c & -(6.28318-dih_diff(i,k)) +c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)= +c & 6.28318+dih_diff(i,k) + + kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument +c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i) + gdih(k)=dexp(kat3) + kat2=kat2+gdih(k) +c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3) +c write(*,*)"" + enddo +c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps +c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps +#ifdef DEBUG + write (iout,*) "i",i," betai",betai," kat2",kat2 + write (iout,*) "gdih",(gdih(k),k=1,constr_homology) +#endif + if (kat2.le.1.0d-14) cycle + kat=kat-dLOG(kat2/constr_homology) +c write (iout,*) "kat",kat ! sum of -ln-s + +ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=", +ccc & dLOG(kat2), "-kat=", -kat + +#ifdef GRAD +c ---------------------------------------------------------------------- +c Gradient +c ---------------------------------------------------------------------- + + sum_gdih=kat2 + sum_sgdih=0.0d0 + do k=1,constr_homology + sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd +c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle + sum_sgdih=sum_sgdih+sgdih + enddo +c grad_dih3=sum_sgdih/sum_gdih + grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih + +c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3 +ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3, +ccc & gloc(nphi+i-3,icg) + gloc(i,icg)=gloc(i,icg)+grad_dih3 +c if (i.eq.25) then +c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg) +c endif +ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3, +ccc & gloc(nphi+i-3,icg) +#endif + enddo ! i-loop for dih +#ifdef DEBUG + write(iout,*) "------- dih restrs end -------" +#endif + +c Pseudo-energy and gradient for theta angle restraints from +c homology templates +c FP 01/15 - inserted from econstr_local_test.F, loop structure +c adapted + +c +c For constr_homology reference structures (FP) +c +c Uconst_back_tot=0.0d0 + Eval=0.0d0 + Erot=0.0d0 +c Econstr_back legacy +#ifdef GRAD + do i=1,nres +c do i=ithet_start,ithet_end + dutheta(i)=0.0d0 +c enddo +c do i=loc_start,loc_end + do j=1,3 + duscdiff(j,i)=0.0d0 + duscdiffx(j,i)=0.0d0 + enddo + enddo +#endif +c +c do iref=1,nref +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "waga_theta",waga_theta + if (waga_theta.gt.0.0d0) then +#ifdef DEBUG + write (iout,*) "usampl",usampl + write(iout,*) "------- theta restrs start -------" +c do i=ithet_start,ithet_end +c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg) +c enddo +#endif +c write (iout,*) "maxres",maxres,"nres",nres + + do i=ithet_start,ithet_end +c +c do i=1,nfrag_back +c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) +c +c Deviation of theta angles wrt constr_homology ref structures +c + utheta_i=0.0d0 ! argument of Gaussian for single k + gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures +c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop +c over residues in a fragment +c write (iout,*) "theta(",i,")=",theta(i) + do k=1,constr_homology +c +c dtheta_i=theta(j)-thetaref(j,iref) +c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing + theta_diff(k)=thetatpl(k,i)-theta(i) +c + utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument +c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta? + gtheta(k)=dexp(utheta_i) ! + min_utheta_i? + gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk) +c Gradient for single Gaussian restraint in subr Econstr_back +c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) +c + enddo +c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps +c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps + +c +#ifdef GRAD +c Gradient for multiple Gaussian restraint + sum_gtheta=gutheta_i + sum_sgtheta=0.0d0 + do k=1,constr_homology +c New generalized expr for multiple Gaussian from Econstr_back + sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd +c +c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form? + sum_sgtheta=sum_sgtheta+sgtheta ! cum variable + enddo +c grad_theta3=sum_sgtheta/sum_gtheta 1/*theta(i)? s. line below +c grad_theta3=sum_sgtheta/sum_gtheta +c +c Final value of gradient using same var as in Econstr_back + dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta + & *waga_homology(iset) +c dutheta(i)=sum_sgtheta/sum_gtheta +c +c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight +#endif + Eval=Eval-dLOG(gutheta_i/constr_homology) +c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps +c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s +c Uconst_back=Uconst_back+utheta(i) + enddo ! (i-loop for theta) +#ifdef DEBUG + write(iout,*) "------- theta restrs end -------" +#endif + endif +c +c Deviation of local SC geometry +c +c Separation of two i-loops (instructed by AL - 11/3/2014) +c +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +c write (iout,*) "waga_d",waga_d + +#ifdef DEBUG + write(iout,*) "------- SC restrs start -------" + write (iout,*) "Initial duscdiff,duscdiffx" + do i=loc_start,loc_end + write (iout,*) i,(duscdiff(jik,i),jik=1,3), + & (duscdiffx(jik,i),jik=1,3) + enddo +#endif + do i=loc_start,loc_end + usc_diff_i=0.0d0 ! argument of Gaussian for single k + guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures +c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy +c write(iout,*) "xxtab, yytab, zztab" +c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i) + do k=1,constr_homology +c + dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str? +c Original sign inverted for calc of gradients (s. Econstr_back) + dyy=-yytpl(k,i)+yytab(i) ! ibid y + dzz=-zztpl(k,i)+zztab(i) ! ibid z +c write(iout,*) "dxx, dyy, dzz" +c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz +c + usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument +c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d? +c uscdiffk(k)=usc_diff(i) + guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff + guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk) +c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), +c & xxref(j),yyref(j),zzref(j) + enddo +c +c Gradient +c +c Generalized expression for multiple Gaussian acc to that for a single +c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014) +c +c Original implementation +c sum_guscdiff=guscdiff(i) +c +c sum_sguscdiff=0.0d0 +c do k=1,constr_homology +c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d? +c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff +c sum_sguscdiff=sum_sguscdiff+sguscdiff +c enddo +c +c Implementation of new expressions for gradient (Jan. 2015) +c +c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !? +#ifdef GRAD + do k=1,constr_homology +c +c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong +c before. Now the drivatives should be correct +c + dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str? +c Original sign inverted for calc of gradients (s. Econstr_back) + dyy=-yytpl(k,i)+yytab(i) ! ibid y + dzz=-zztpl(k,i)+zztab(i) ! ibid z +c +c New implementation +c + sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong! + & sigma_d(k,i) ! for the grad wrt r' +c sum_sguscdiff=sum_sguscdiff+sum_guscdiff +c +c +c New implementation + sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff + do jik=1,3 + duscdiff(jik,i-1)=duscdiff(jik,i-1)+ + & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+ + & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i) + duscdiff(jik,i)=duscdiff(jik,i)+ + & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+ + & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i) + duscdiffx(jik,i)=duscdiffx(jik,i)+ + & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+ + & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i) +c +#ifdef DEBUG + write(iout,*) "jik",jik,"i",i + write(iout,*) "dxx, dyy, dzz" + write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz + write(iout,*) "guscdiff2(",k,")",guscdiff2(k) +c write(iout,*) "sum_sguscdiff",sum_sguscdiff +cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i) +c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i) +c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i) +c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i) +c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i) +c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i) +c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i) +c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i) +c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i) +c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1) +c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i) +c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i) +c endif +#endif + enddo + enddo +#endif +c +c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required? +c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ? +c +c write (iout,*) i," uscdiff",uscdiff(i) +c +c Put together deviations from local geometry + +c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ +c & wfrag_back(3,i,iset)*uscdiff(i) + Erot=Erot-dLOG(guscdiff(i)/constr_homology) +c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps +c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s +c Uconst_back=Uconst_back+usc_diff(i) +c +c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?) +c +c New implment: multiplied by sum_sguscdiff +c + + enddo ! (i-loop for dscdiff) + +c endif + +#ifdef DEBUG + write(iout,*) "------- SC restrs end -------" + write (iout,*) "------ After SC loop in e_modeller ------" + do i=loc_start,loc_end + write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3) + write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3) + enddo + if (waga_theta.eq.1.0d0) then + write (iout,*) "in e_modeller after SC restr end: dutheta" + do i=ithet_start,ithet_end + write (iout,*) i,dutheta(i) + enddo + endif + if (waga_d.eq.1.0d0) then + write (iout,*) "e_modeller after SC loop: duscdiff/x" + do i=1,nres + write (iout,*) i,(duscdiff(j,i),j=1,3) + write (iout,*) i,(duscdiffx(j,i),j=1,3) + enddo + endif +#endif + +c Total energy from homology restraints +#ifdef DEBUG + write (iout,*) "odleg",odleg," kat",kat + write (iout,*) "odleg",odleg," kat",kat + write (iout,*) "Eval",Eval," Erot",Erot + write (iout,*) "waga_homology(",iset,")",waga_homology(iset) + write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle + write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d + write (iout,*) "waga_homology(",iset,")",waga_homology(iset) +#endif +c +c Addition of energy of theta angle and SC local geom over constr_homologs ref strs +c +c ehomology_constr=odleg+kat +c +c For Lorentzian-type Urestr +c + + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + ehomology_constr=(waga_dist*odleg+waga_angle*kat+ + & waga_theta*Eval+waga_d*Erot)*waga_homology(iset) +c write (iout,*) "ehomology_constr=",ehomology_constr + else +c +c For Lorentzian-type Urestr +c + ehomology_constr=(-waga_dist*odleg+waga_angle*kat+ + & waga_theta*Eval+waga_d*Erot)*waga_homology(iset) +c write (iout,*) "ehomology_constr=",ehomology_constr + endif +c write (iout,*) "odleg",odleg," kat",kat," Eval",Eval," Erot",Erot +c write (iout,*) "ehomology_constr",ehomology_constr +c ehomology_constr=odleg+kat+Uconst_back + return + + 748 format(a8,f12.3,a6,f12.3,a7,f12.3) + 747 format(a12,i4,i4,i4,f8.3,f8.3) + 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3) + 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3) + 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, + & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3) + end C-------------------------------------------------------------------------- subroutine ebond(estr) c @@ -3353,8 +4005,9 @@ C & sinph1ph2(maxdouble,maxdouble) logical lprn /.false./, lprn1 /.false./ etheta=0.0D0 -c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end + if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + & (itype(i).eq.ntyp1)) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -3364,7 +4017,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3) then + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -3378,13 +4031,13 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) enddo else phii=0.0d0 - ityp1=nthetyp+1 + ityp1=ithetyp(itype(i-2)) do k=1,nsingle cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres) then + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -3508,10 +4161,13 @@ c call flush(iout) enddo enddo 10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, +c lprn1=.true. + if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)') + & 'ebe',i,theta(i)*rad2deg,phii*rad2deg, & phii1*rad2deg,ethetai +c lprn1=.false. etheta=etheta+ethetai + if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 gloc(nphi+i-2,icg)=wang*dethetai diff --git a/source/cluster/wham/src/include_unres/COMMON.DERIV b/source/cluster/wham/src/include_unres/COMMON.DERIV index 79f8630..596a365 100644 --- a/source/cluster/wham/src/include_unres/COMMON.DERIV +++ b/source/cluster/wham/src/include_unres/COMMON.DERIV @@ -3,7 +3,7 @@ & gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn, & gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc, & g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc, - & gscloc,gsclocx + & gscloc,gsclocx,gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), @@ -19,7 +19,9 @@ & gel_loc_turn6(maxvar),gcorr_loc(maxvar), & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), & gsccorx(3,maxres),gsccor_loc(maxres), - & gscloc(3,maxres),gsclocx(3,maxres),nfl,icg,calc_grad + & gscloc(3,maxres),gsclocx(3,maxres), + & gdfad(3,maxres),gdfat(3,maxres),gdfan(3,maxres),gdfab(3,maxres), + & nfl,icg,calc_grad double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), diff --git a/source/cluster/wham/src/include_unres/COMMON.FFIELD b/source/cluster/wham/src/include_unres/COMMON.FFIELD index 0c169f7..cf03bcd 100644 --- a/source/cluster/wham/src/include_unres/COMMON.FFIELD +++ b/source/cluster/wham/src/include_unres/COMMON.FFIELD @@ -6,11 +6,13 @@ C----------------------------------------------------------------------- double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, & wturn6,wvdwpp,wbond,weights,scal14,cutoff_corr,delt_corr, + & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, & r0_corr integer ipot,n_ene_comp common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, & wturn6,wvdwpp,wbond,weights(max_ene), + & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp common /potentials/ potname(5) character*3 potname diff --git a/source/cluster/wham/src/include_unres/COMMON.FRAG b/source/cluster/wham/src/include_unres/COMMON.FRAG index ee151f5..7879d51 100644 --- a/source/cluster/wham/src/include_unres/COMMON.FRAG +++ b/source/cluster/wham/src/include_unres/COMMON.FRAG @@ -1,5 +1,4 @@ - integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0, + integer nbfrag,bfrag,nhfrag,hfrag,nhpb0, & nh310frag,h310frag COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3), & nh310frag,h310frag(2,maxres/2) - COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3) diff --git a/source/cluster/wham/src/include_unres/COMMON.MD b/source/cluster/wham/src/include_unres/COMMON.MD deleted file mode 100644 index 40131bd..0000000 --- a/source/cluster/wham/src/include_unres/COMMON.MD +++ /dev/null @@ -1,77 +0,0 @@ - double precision gcart, gxcart, gradcag,gradxag - common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES), - & gradcag(3,MAXRES),gradxag(3,MAXRES) - integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20), - & ipair(2,100,maxprocs/20),iset, - & mset(maxprocs/20),nset - double precision IP,ISC(ntyp+1),mp, - & msc(ntyp+1),d_t_work(MAXRES6), - & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2), - & d_af_work(MAXRES6),d_as_work(MAXRES6), - & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2), - & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2), - & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6), - & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2), - & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2) - double precision v_ini,d_time,d_time0,t_bath,tau_bath, - & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax, - & edriftmax, - & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20), - & qfrag(50),qpair(100), - & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20), - & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, - & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), - & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back), - & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres), - & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20), - & uconst_back - integer n_timestep,ntwx,ntwe,lang,count_reset_moment, - & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back, - & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0, - & maxtime_split - integer nresn,nyosh,nnos - double precision glogs,qmass,vlogs,xlogs - logical large,print_compon,tbf,rest,reset_moment,reset_vel, - & surfarea,rattle,usampl,mdpdb,RESPA,tnp,tnp1,tnh,xiresp - integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts, - & nginv_start,nginv_counts,myginv_ng_count - common /back_constr/ uconst_back,utheta,ugamma,uscdiff, - & dutheta,dugamma,duscdiff,duscdiffx, - & wfrag_back,nfrag_back,ifrag_back - common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time, - & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst, - & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag - common /mdpar/ v_ini,d_time,d_time0,scal_fric, - & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb, - & ntime_split,ntime_split0,maxtime_split, - & ntwx,ntwe,large,print_compon,tbf,rest,tnp,tnp1,tnh - common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax, - & kinetic_T - common /lagrange/ d_t,d_t_old,d_t_new,d_t_work, - & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short, - & kinetic_force, - & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm, - & vtot,dimen,dimen1,dimen3,lang, - & reset_moment,reset_vel,count_reset_moment,count_reset_vel, - & rattle,RESPA - common /inertia/ IP,ISC,MP,MSC - double precision scal_fric,rwat,etawat,gamp, - & gamsc(ntyp),stdfp,stdfsc(ntyp),stdforcp(MAXRES), - & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb - common /langevin/ pstok,restok,gamp,gamsc, - & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea, - & reset_fricmat - common /mdpmpi/ igmult_start,igmult_end,my_ng_count, - & myginv_ng_count, - & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1), - & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1) - double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long, - & sold_np,d_t_half,Csplit,hhh - common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0, - & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit,hhh - common /nosehoover/ glogs(maxmnh),qmass(maxmnh), - & vlogs(maxmnh),xlogs(maxmnh), - & nresn,nyosh,nnos,xiresp - integer hmc,hmc_acc - double precision dc_hmc,hmc_etot,totThmc - common /hmc_md/ dc_hmc(3,0:maxres2),hmc_etot,totThmc,hmc,hmc_acc diff --git a/source/cluster/wham/src/include_unres/COMMON.SETUP b/source/cluster/wham/src/include_unres/COMMON.SETUP deleted file mode 100644 index 5039116..0000000 --- a/source/cluster/wham/src/include_unres/COMMON.SETUP +++ /dev/null @@ -1,21 +0,0 @@ - integer king,idint,idreal,idchar,is_done - parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1) - integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1), - & kolor1,key1,nfgtasks1,MyRank, - & max_gs_size - logical yourjob, finished, cgdone - common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs, - & nfgtasks,nfgtasks1, - & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp - integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1), - & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1), - & MPI_PRECOMP23(0:1) - common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12, - & MPI_PRECOMP22,MPI_PRECOMP23 diff --git a/source/cluster/wham/src/initialize_p.F b/source/cluster/wham/src/initialize_p.F index f8b9426..3f0e04b 100644 --- a/source/cluster/wham/src/initialize_p.F +++ b/source/cluster/wham/src/initialize_p.F @@ -227,14 +227,16 @@ c------------------------------------------------------------------------- & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP", - & "ESTR","ESCCOR","EVDW2_14",""/ + & "ESTR","ESCCOR","EVDW2_14","EDIHCNSTR","EHOMOLOGY", + & "DFA DIS","DFA TOR","DFA NEI","DFA BET"," "," "/ data wname / & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WHPB","WVDWPP","WBOND","WSCCOR","WSCP14",""/ - data nprint_ene /18/ + & "WHPB","WVDWPP","WBOND","WSCCOR","WSCP14","WDIHCNSTR", + & "WHOMOLOGY","WDFAD","WDFAT","WDFAN","WDFAB"," "," "/ + data nprint_ene /23/ data print_order /1,2,3,17,11,12,13,14,4,5,6,7,8,9,10,16,15,18,19, - & 20/ + & 20,21,22,23,24,25/ end c--------------------------------------------------------------------------- subroutine init_int_table @@ -569,3 +571,45 @@ cd & ' nhpb',nhpb,' link_start=',link_start, cd & ' link_end',link_end return end +c------------------------------------------------------------------------------ + subroutine homology_partition + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SBRIDGE' + include 'COMMON.IOUNITS' +c include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.HOMRESTR' + write(iout,*)"homology_partition: lim_odl=",lim_odl, + & " lim_dih",lim_dih +#ifdef MPL + call int_bounds(lim_odl,link_start_homo,link_end_homo) + call int_bounds(lim_dih-nnt+1,idihconstr_start_homo, + & idihconstr_end_homo) + idihconstr_start_homo=idihconstr_start_homo+nnt-1 + idihconstr_end_homo=idihconstr_end_homo+nnt-1 + if (me.eq.king .or. .not. out1file) + & write (iout,*) 'Processor',fg_rank,' CG group',kolor, + & ' absolute rank',MyRank, + & ' lim_odl',lim_odl,' link_start=',link_start_homo, + & ' link_end',link_end_homo,' lim_dih',lim_dih, + & ' idihconstr_start_homo',idihconstr_start_homo, + & ' idihconstr_end_homo',idihconstr_end_homo +#else + link_start_homo=1 + link_end_homo=lim_odl + idihconstr_start_homo=nnt + idihconstr_end_homo=lim_dih + write (iout,*) + & ' lim_odl',lim_odl,' link_start=',link_start_homo, + & ' link_end',link_end_homo,' lim_dih',lim_dih, + & ' idihconstr_start_homo',idihconstr_start_homo, + & ' idihconstr_end_homo',idihconstr_end_homo +#endif + return + end diff --git a/source/cluster/wham/src/int_from_cart1.F b/source/cluster/wham/src/int_from_cart1.F new file mode 100644 index 0000000..7d266de --- /dev/null +++ b/source/cluster/wham/src/int_from_cart1.F @@ -0,0 +1,63 @@ + subroutine int_from_cart1(lprn) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'sizesclu.dat' + include 'COMMON.IOUNITS' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.LOCAL' + include 'COMMON.NAMES' + logical lprn + if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates' + vbld(nres+1)=0.0d0 + vbld(2*nres)=0.0d0 + vbld_inv(nres+1)=0.0d0 + vbld_inv(2*nres)=0.0d0 + do i=2,nres + dnorm1=dist(i-1,i) + dnorm2=dist(i,i+1) + do j=1,3 + c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1 + & +(c(j,i+1)-c(j,i))/dnorm2) + enddo + be=0.0D0 + if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) + if (i.gt.2) tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) + if (i.gt.2) tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) + if (i.gt.2) tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) + omeg(i)=beta(nres+i,i,maxres2,i+1) + theta(i+1)=alpha(i-1,i,i+1) + alph(i)=alpha(nres+i,i,maxres2) + vbld(i)=dist(i-1,i) + vbld_inv(i)=1.0d0/vbld(i) + vbld(nres+i)=dist(nres+i,i) + if (itype(i).ne.10) then + vbld_inv(nres+i)=1.0d0/vbld(nres+i) + else + vbld_inv(nres+i)=0.0d0 + endif + enddo + 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=1,nres + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo + enddo + if (lprn) then + do i=2,nres + write (iout,1212) restyp(itype(i)),i,vbld(i), + &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i), + &rad2deg*alph(i),rad2deg*omeg(i) + enddo + endif + 1212 format (a3,'(',i3,')',2(f15.10,2f10.2)) + return + end diff --git a/source/cluster/wham/src/int_from_cart1.f b/source/cluster/wham/src/int_from_cart1.f deleted file mode 100644 index 7d266de..0000000 --- a/source/cluster/wham/src/int_from_cart1.f +++ /dev/null @@ -1,63 +0,0 @@ - subroutine int_from_cart1(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'sizesclu.dat' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - logical lprn - if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates' - vbld(nres+1)=0.0d0 - vbld(2*nres)=0.0d0 - vbld_inv(nres+1)=0.0d0 - vbld_inv(2*nres)=0.0d0 - do i=2,nres - dnorm1=dist(i-1,i) - dnorm2=dist(i,i+1) - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1 - & +(c(j,i+1)-c(j,i))/dnorm2) - enddo - be=0.0D0 - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - if (i.gt.2) tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) - if (i.gt.2) tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) - if (i.gt.2) tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) - omeg(i)=beta(nres+i,i,maxres2,i+1) - theta(i+1)=alpha(i-1,i,i+1) - alph(i)=alpha(nres+i,i,maxres2) - vbld(i)=dist(i-1,i) - vbld_inv(i)=1.0d0/vbld(i) - vbld(nres+i)=dist(nres+i,i) - if (itype(i).ne.10) then - vbld_inv(nres+i)=1.0d0/vbld(nres+i) - else - vbld_inv(nres+i)=0.0d0 - endif - enddo - 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=1,nres - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - enddo - if (lprn) then - do i=2,nres - write (iout,1212) restyp(itype(i)),i,vbld(i), - &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i), - &rad2deg*alph(i),rad2deg*omeg(i) - enddo - endif - 1212 format (a3,'(',i3,')',2(f15.10,2f10.2)) - return - end diff --git a/source/cluster/wham/src/main_clust.F b/source/cluster/wham/src/main_clust.F index 4b6478a..f4d63f8 100644 --- a/source/cluster/wham/src/main_clust.F +++ b/source/cluster/wham/src/main_clust.F @@ -59,9 +59,9 @@ C stop endif #endif - call initialize call openunits + call cinfo call parmread call read_control call molread diff --git a/source/cluster/wham/src/probabl.F b/source/cluster/wham/src/probabl.F index 7fcd29b..3071d4c 100644 --- a/source/cluster/wham/src/probabl.F +++ b/source/cluster/wham/src/probabl.F @@ -15,6 +15,7 @@ include "COMMON.SBRIDGE" include "COMMON.CHAIN" include "COMMON.CLUSTER" + include "COMMON.NAMES" real*4 csingle(3,maxres2) double precision fT(5),fTprim(5),fTbis(5),quot,quotl1,quotl,kfacl, & eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/ @@ -22,7 +23,9 @@ & ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor integer i,ii,ik,iproc,iscor,j,k,l,ib,nlist,ncon - double precision qfree,sumprob,eini,efree,rmsdev + integer ires + double precision qfree,sumprob,eini,efree,rmsdev,ehomology_constr, + & edfadis,edfator,edfanei,edfabet character*80 bxname character*2 licz1 character*5 ctemper @@ -111,13 +114,20 @@ c write (iout,*) "i",i," ii",ii call int_from_cart1(.false.) call etotal(energia(0),fT) totfree(i)=energia(0) -c#define DEBUG #ifdef DEBUG write (iout,*) i," energia",(energia(j),j=0,20) call enerprint(energia(0),ft) + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + + call intout call flush(iout) #endif -c#undef DEBUG do k=1,max_ene enetb(k,i)=energia(k) enddo @@ -153,6 +163,11 @@ cc if (wcorr6.eq.0) ecorr6=0.0d0 estr=enetb(18,i) esccor=enetb(19,i) edihcnstr=enetb(20,i) + ehomology_constr=enetb(21,i) + edfadis=enetb(22,i) + edfator=enetb(23,i) + edfanei=enetb(24,i) + edfabet=enetb(25,i) #ifdef SPLITELE etot=wsc*evdw+wscp*evdw2+ft(1)*welec*ees+wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc @@ -161,7 +176,8 @@ cc if (wcorr6.eq.0) ecorr6=0.0d0 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr+wdfa_dist*edfadis + & +wdfa_tor*edfator+wdfa_nei*edfanei+wdfa_beta*edfabet #else etot=wsc*evdw+wscp*evdw2+ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc @@ -169,8 +185,9 @@ cc if (wcorr6.eq.0) ecorr6=0.0d0 & +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 + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor+wdfa_dist*edfadis + & +wdfa_tor*edfator+wdfa_nei*edfanei+wdfa_beta*edfabet + & +wbond*estr+ehomology_constr #endif Fdimless(i)=beta_h(ib)*etot+entfac(ii) totfree(i)=etot @@ -196,7 +213,6 @@ cc if (wcorr6.eq.0) ecorr6=0.0d0 & MPI_COMM_WORLD, IERROR) if (me.eq.Master) then #endif -c#define DEBUG #ifdef DEBUG write (iout,*) "The FDIMLESS array before sorting" do i=1,ncon @@ -210,7 +226,6 @@ c#define DEBUG write (iout,*) i,list_conf(i),fdimless(i) enddo #endif -c#undef DEBUG do i=1,ncon totfree(i)=fdimless(i) enddo diff --git a/source/cluster/wham/src/read_coords.F b/source/cluster/wham/src/read_coords.F index cf98db7..15456a2 100644 --- a/source/cluster/wham/src/read_coords.F +++ b/source/cluster/wham/src/read_coords.F @@ -178,13 +178,11 @@ c through a ring. #endif endif -#define DEBUG #ifdef DEBUG write (iout,*) "Opening file ",intinname(:ilen(intinname)) write (iout,*) "lenrec",lenrec_in call flush(iout) #endif -#undef DEBUG c write (iout,*) "maxconf",maxconf i=0 do while (.true.) diff --git a/source/cluster/wham/src/readpdb.F b/source/cluster/wham/src/readpdb.F new file mode 100644 index 0000000..a7b024f --- /dev/null +++ b/source/cluster/wham/src/readpdb.F @@ -0,0 +1,510 @@ + subroutine readpdb +C Read the PDB file and convert the peptide geometry into virtual-chain +C geometry. + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.FRAG' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.CONTROL' +c include 'COMMON.DISTFIT' + include 'COMMON.SETUP' + integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity +c & ishift_pdb + logical lprn /.false./,fail + double precision e1(3),e2(3),e3(3) + double precision dcj,efree_temp + character*3 seq,res + character*5 atom + character*80 card + double precision sccor(3,20) + integer rescode + efree_temp=0.0d0 + ibeg=1 + ishift1=0 + ishift=0 +c write (2,*) "UNRES_PDB",unres_pdb + ires=0 + ires_old=0 + iii=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + do i=1,10000 + read (ipdbin,'(a80)',end=10) card +c 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) + endif + if (card(:5).eq.'SHEET') then + nbfrag=nbfrag+1 + lsecondary=.true. + read(card(24:26),*) bfrag(1,nbfrag) + read(card(35:37),*) bfrag(2,nbfrag) +crc---------------------------------------- +crc to be corrected !!! + bfrag(3,nbfrag)=bfrag(1,nbfrag) + bfrag(4,nbfrag)=bfrag(2,nbfrag) +crc---------------------------------------- + endif + if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 +c Read free energy + if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +C Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + read (card(12:16),*) atom +c write (iout,*) "! ",atom," !",ires +c if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +C Calculate the CM of the preceding residue. +c if (ibeg.eq.0) call sccenter(ires,iii,sccor) + if (ibeg.eq.0) then +c write (iout,*) "Calculating sidechain center iii",iii +c if (unres_pdb) then +c do j=1,3 +c dc(j,ires)=sccor(j,iii) +c enddo +c else + call sccenter(ires_old,iii,sccor) +c endif + iii=0 + endif +C Start new residue. + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=21 + endif + ires=ires-ishift+ishift1 + ires_old=ires +c write (iout,*) "ishift",ishift," ires",ires, +c & " ires_old",ires_old + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires + if (card(27:27).eq."A" .or. card(27:27).eq."B") then +c ishift1=ishift1+1 + endif +c write (2,*) "ires",ires," res ",res," ity",ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom +#ifdef DEBUG + write (iout,'(2i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo + if (ishift.ne.0) then + ires_ca=ires+ishift-ishift1 + else + ires_ca=ires + endif +c write (*,*) card(23:27),ires,itype(ires) + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +c write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) + endif + endif + enddo + 10 continue +#ifdef DEBUG + write (iout,'(a,i5)') ' Number of residues found: ',ires +#endif + if (ires.eq.0) return +C Calculate the CM of the last side chain. + if (iii.gt.0) then +c if (unres_pdb) then +c do j=1,3 +c dc(j,ires)=sccor(j,iii) +c enddo +c else + call sccenter(ires,iii,sccor) +c endif + endif + nres=ires + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=21 + do j=1,3 + dcj=c(j,nres-2)-c(j,nres-3) + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.21) then + nsup=nsup-1 + nstart_sup=2 +c if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue +c call refsys(2,3,4,e1,e2,e3,fail) +c if (fail) then +c e2(1)=0.0d0 +c e2(2)=1.0d0 +c e2(3)=0.0d0 +c endif +c do j=1,3 +c c(j,1)=c(j,2)-3.8d0*e2(j) +c enddo +c else + do j=1,3 + dcj=c(j,4)-c(j,3) + c(j,1)=c(j,2)-dcj + c(j,nres+1)=c(j,1) + enddo +c endif + endif +C Copy the coordinates to reference coordinates +c do i=1,2*nres +c do j=1,3 +c cref(j,i)=c(j,i) +c enddo +c enddo +C Calculate internal coordinates. + if (lprn) then + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + endif +C Calculate internal coordinates. + if(me.eq.king.or..not.out1file)then + write (iout,'(a)') + & "Backbone and SC coordinates as read from the PDB" + do ires=1,nres + write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') + & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), + & (c(j,nres+ires),j=1,3) + enddo + endif + call int_from_cart1(.false.) + call int_from_cart(.true.,.false.) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) +c + phi_ref(i)=phi(i) + theta_ref(i)=theta(i) + alph_ref(i)=alph(i) + omeg_ref(i)=omeg(i) +c + enddo +#ifdef DEBUG + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), +c & vbld_inv(i+nres) + enddo +#endif +c call chainbuild +C Copy the coordinates to reference coordinates + do i=1,2*nres + do j=1,3 + cref(j,i)=c(j,i) + enddo + enddo + + + do j=1,nbfrag + do i=1,4 + bfrag(i,j)=bfrag(i,j)-ishift + enddo + enddo + + do j=1,nhfrag + do i=1,2 + hfrag(i,j)=hfrag(i,j)-ishift + enddo + enddo + ishift_pdb=ishift + return + end +c--------------------------------------------------------------------------- + subroutine int_from_cart(lside1,lprn) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include "mpif.h" +#endif + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.CONTROL' + include 'COMMON.SETUP' + character*3 seq,atom,res +c character*5 atom + character*80 card + double precision sccor(3,20) +c dimension sccor(3,20) + integer rescode + logical lside1,lprn + double precision dist,alpha,beta,di + if(me.eq.king.or..not.out1file)then + if (lprn) then + write (iout,'(/a)') + & 'Internal coordinates calculated from crystal structure.' + if (lside) then + write (iout,'(8a)') ' Res ',' dvb',' Theta', + & ' Gamma',' Dsc_id',' Dsc',' Alpha', + & ' Beta ' + else + write (iout,'(4a)') ' Res ',' dvb',' Theta', + & ' Gamma' + endif + endif + endif + do i=1,nres-1 + iti=itype(i) + if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then + write (iout,'(a,i4)') 'Bad Cartesians for residue',i +ctest stop + endif + vbld(i+1)=dist(i,i+1) + vbld_inv(i+1)=1.0d0/vbld(i+1) + if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) + if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) + enddo +c if (unres_pdb) then +c if (itype(1).eq.21) then +c theta(3)=90.0d0*deg2rad +c phi(4)=180.0d0*deg2rad +c vbld(2)=3.8d0 +c vbld_inv(2)=1.0d0/vbld(2) +c endif +c if (itype(nres).eq.21) then +c theta(nres)=90.0d0*deg2rad +c phi(nres)=180.0d0*deg2rad +c vbld(nres)=3.8d0 +c vbld_inv(nres)=1.0d0/vbld(2) +c endif +c endif + if (lside) then + do i=2,nres-1 + do j=1,3 + c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) + & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) + enddo + iti=itype(i) + di=dist(i,nres+i) +C 10/03/12 Adam: Correction for zero SC-SC bond length + if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) + & di=dsc(itype(i)) + vbld(i+nres)=di + if (itype(i).ne.10) then + vbld_inv(i+nres)=1.0d0/di + else + vbld_inv(i+nres)=0.0d0 + endif + if (iti.ne.10) then + alph(i)=alpha(nres+i,i,maxres2) + omeg(i)=beta(nres+i,i,maxres2,i+1) + endif + if(me.eq.king.or..not.out1file)then + if (lprn) + & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), + & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), + & rad2deg*alph(i),rad2deg*omeg(i) + endif + enddo + else if (lprn) then + do i=2,nres + iti=itype(i) + if(me.eq.king.or..not.out1file) + & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), + & rad2deg*theta(i),rad2deg*phi(i) + enddo + endif + return + end +c------------------------------------------------------------------------------- + subroutine sc_loc_geom(lprn) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include "mpif.h" +#endif + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.CONTROL' + include 'COMMON.SETUP' + double precision x_prime(3),y_prime(3),z_prime(3) + logical lprn + do i=1,nres-1 + do j=1,3 + dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) + enddo + enddo + do i=2,nres-1 + if (itype(i).ne.10) then + do j=1,3 + dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) + enddo + else + do j=1,3 + dc_norm(j,i+nres)=0.0d0 + enddo + endif + enddo + do i=2,nres-1 + costtab(i+1) =dcos(theta(i+1)) + sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) + cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) + sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) + cosfac2=0.5d0/(1.0d0+costtab(i+1)) + cosfac=dsqrt(cosfac2) + sinfac2=0.5d0/(1.0d0-costtab(i+1)) + sinfac=dsqrt(sinfac2) + it=itype(i) + if (it.ne.10) then +c +C Compute the axes of tghe local cartesian coordinates system; store in +c x_prime, y_prime and z_prime +c + do j=1,3 + x_prime(j) = 0.00 + y_prime(j) = 0.00 + z_prime(j) = 0.00 + enddo + do j = 1,3 + x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac + y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac + enddo + call vecpr(x_prime,y_prime,z_prime) +c +C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), +C to local coordinate system. Store in xx, yy, zz. +c + xx=0.0d0 + yy=0.0d0 + zz=0.0d0 + do j = 1,3 + xx = xx + x_prime(j)*dc_norm(j,i+nres) + yy = yy + y_prime(j)*dc_norm(j,i+nres) + zz = zz + z_prime(j)*dc_norm(j,i+nres) + enddo + + xxref(i)=xx + yyref(i)=yy + zzref(i)=zz + else + xxref(i)=0.0d0 + yyref(i)=0.0d0 + zzref(i)=0.0d0 + endif + enddo + if (lprn) then + do i=2,nres + iti=itype(i) + if(me.eq.king.or..not.out1file) + & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), + & yyref(i),zzref(i) + enddo + endif + return + end +c--------------------------------------------------------------------------- + subroutine sccenter(ires,nscat,sccor) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + dimension sccor(3,20) + do j=1,3 + sccmj=0.0D0 + do i=1,nscat + sccmj=sccmj+sccor(j,i) + enddo + dc(j,ires)=sccmj/nscat + enddo + return + end +c--------------------------------------------------------------------------- + subroutine bond_regular + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CALC' + include 'COMMON.INTERACT' + include 'COMMON.CHAIN' + do i=1,nres-1 + vbld(i+1)=vbl + vbld_inv(i+1)=1.0d0/vbld(i+1) + vbld(i+1+nres)=dsc(itype(i+1)) + vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) +c print *,vbld(i+1),vbld(i+1+nres) + enddo + return + end diff --git a/source/cluster/wham/src/readpdb.f b/source/cluster/wham/src/readpdb.f deleted file mode 100644 index de5811c..0000000 --- a/source/cluster/wham/src/readpdb.f +++ /dev/null @@ -1,183 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - ibeg=1 - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) call sccenter(ires,iii,sccor) -C Start new residue. - read (card(24:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - endif - ires=ires-ishift - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) - write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - call sccenter(ires,iii,sccor) - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo -C Calculate internal coordinates. -c do ires=1,nres -c write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3) -c enddo - call int_from_cart(.true.,.true.) - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - 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' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Phi',' Dsc_id',' Dsc',' Alpha', - & ' Omega' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Phi' - endif - endif - call flush(iout) - do i=nnt+1,nct - iti=itype(i) -c write (iout,*) i,dist(i,i-1) - if (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i - stop - endif - theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di,rad2deg*alph(i), - & rad2deg*omeg(i) - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end diff --git a/source/cluster/wham/src/readrtns.F b/source/cluster/wham/src/readrtns.F index c40fcbb..d862542 100644 --- a/source/cluster/wham/src/readrtns.F +++ b/source/cluster/wham/src/readrtns.F @@ -24,6 +24,7 @@ C call card_concat(controlcard) call readi(controlcard,'NRES',nres,0) + write (iout,*) "NRES",NRES call readi(controlcard,'RESCALE',rescale_mode,2) call readi(controlcard,'PDBOUT',outpdb,0) call readi(controlcard,'MOL2OUT',outmol2,0) @@ -64,6 +65,11 @@ C call readi(controlcard,'CONSTR_DIST',constr_dist,0) write (iout,*) "with_dihed_constr ",with_dihed_constr, & " CONSTR_DIST",constr_dist + + call readi(controlcard,'CONSTR_HOMOL',constr_homology,0) + write (iout,*) "with_homology_constr ",with_dihed_constr, + & " CONSTR_HOMOLOGY",constr_homology + call flush(iout) if (min_var) iopt=1 return @@ -99,6 +105,7 @@ C integer itype_pdb(maxres) logical seq_comp integer i,j + write (iout,*) " MOLREAD: NRES",NRES C C Body C @@ -135,6 +142,11 @@ C Read weights of the subsequent energy terms. call reada(weightcard,"V2SS",v2ss,7.61d0) call reada(weightcard,"V3SS",v3ss,13.7d0) call reada(weightcard,"EBR",ebr,-5.50D0) +C Bartek + call reada(weightcard,'WDFAD',wdfa_dist,0.0d0) + call reada(weightcard,'WDFAT',wdfa_tor,0.0d0) + call reada(weightcard,'WDFAN',wdfa_nei,0.0d0) + call reada(weightcard,'WDFAB',wdfa_beta,0.0d0) if (index(weightcard,'SOFT').gt.0) ipot=6 C 12/1/95 Added weight for the multi-body term WCORR call reada(weightcard,'WCORRH',wcorr,1.0D0) @@ -183,9 +195,13 @@ C 12/1/95 Added weight for the multi-body term WCORR weights(16)=wvdwpp weights(17)=wbond weights(18)=scal14 + weights(22)=wdfa_dist + weights(23)=wdfa_tor + weights(24)=wdfa_nei + weights(25)=wdfa_beta write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wturn3, - & wturn4,wturn6,wsccor + & wturn4,wturn6,wsccor,wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta 10 format (/'Energy-term weights (unscaled):'// & 'WSCC= ',f10.6,' (SC-SC)'/ & 'WSCP= ',f10.6,' (SC-p)'/ @@ -204,7 +220,11 @@ C 12/1/95 Added weight for the multi-body term WCORR & '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)') + & 'WSCCOR= ',f10.6,' (SC-backbone torsional correalations)'/ + & 'WDFAD= ',f10.6,' (DFA distance)'/ + & 'WDFAT= ',f10.6,' (DFA torsional)'/ + & 'WDFAN= ',f10.6,' (DFA neighbors)'/ + & 'WDFAB= ',f10.6,' (DFA beta)'/) if (wcorr4.gt.0.0d0) then write (iout,'(/2a/)') 'Local-electrostatic type correlation ', & 'between contact pairs of peptide groups' @@ -286,6 +306,7 @@ C Convert sequence to numeric code endif endif + nnt=1 nct=nres print *,'NNT=',NNT,' NCT=',NCT @@ -295,6 +316,29 @@ C Convert sequence to numeric code if (nend.gt.nct .or. nend.eq.0) nend=nct write (iout,*) "nstart",nstart," nend",nend nres0=nres + +C Juyong:READ init_vars +C Initialize variables! +C Juyong:READ read_info +C READ fragment information!! +C both routines should be in dfa.F file!! + + if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. + & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then + write (iout,*) "Calling init_dfa_vars" + call flush(iout) + call init_dfa_vars + write (iout,*) 'init_dfa_vars finished!' + call flush(iout) + call read_dfa_info + write (iout,*) 'read_dfa_info finished!' + call flush(iout) + endif + + if (constr_homology.gt.0) then + call read_constr_homology + endif + c if (pdbref) then c read(inp,'(a)') pdbfile c write (iout,'(2a)') 'PDB data will be read from file ',pdbfile @@ -408,7 +452,7 @@ C Read information about disulfide bridges. integer i,j C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns + write(iout,*)'ns=',ns C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then @@ -801,3 +845,396 @@ c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) call flush(iout) return end + +c====------------------------------------------------------------------- + subroutine read_constr_homology + + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.HOMRESTR' +c +c For new homol impl +c + include 'COMMON.VAR' +c include 'include_unres/COMMON.VAR' +c + +c double precision odl_temp,sigma_odl_temp,waga_theta,waga_d, +c & dist_cut +c common /przechowalnia/ odl_temp(maxres,maxres,max_template), +c & sigma_odl_temp(maxres,maxres,max_template) + character*2 kic2 + character*24 model_ki_dist, model_ki_angle + character*500 controlcard + integer ki, i, j, k, l + logical lprn /.true./ +c +c FP - Nov. 2014 Temporary specifications for new vars +c + double precision rescore_tmp,x12,y12,z12 + double precision, dimension (max_template,maxres) :: rescore + character*24 tpl_k_rescore +c ----------------------------------------------------------------- +c Reading multiple PDB ref structures and calculation of retraints +c not using pre-computed ones stored in files model_ki_{dist,angle} +c FP (Nov., 2014) +c ----------------------------------------------------------------- +c +c +c Alternative: reading from input + write (iout,*) "BEGIN READ HOMOLOGY INFO" + call flush(iout) + call card_concat(controlcard) + call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0) + call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0) + call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new + call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new + call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma + + call readi(controlcard,"HOMOL_NSET",homol_nset,1) + if (homol_nset.gt.1)then + call card_concat(controlcard) + read(controlcard,*) (waga_homology(i),i=1,homol_nset) + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) "iset homology_weight " +#ifdef DEBUG + homol_nset=1 + call reada(controlcard,"WAGA_HOMOLOGY",waga_homology(1),1.0d0) +#endif + endif + iset=mod(kolor,homol_nset)+1 + else + iset=1 + waga_homology(1)=1.0 + endif +c + write(iout,*) "read_constr_homology" + write(iout,*) "waga_homology(",iset,")",waga_homology(iset) + call flush(iout) + + +cd write (iout,*) "nnt",nnt," nct",nct +cd call flush(iout) + + + lim_odl=0 + lim_dih=0 +c +c New +c + lim_theta=0 + lim_xx=0 +c +c Reading HM global scores (prob not required) +c +c open (4,file="HMscore") +c do k=1,constr_homology +c read (4,*,end=521) hmscore_tmp +c hmscore(k)=hmscore_tmp ! Another transformation can be used +c write(*,*) "Model", k, ":", hmscore(k) +c enddo +c521 continue + +c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d + + write (iout,*) "CONSTR_HOMOLOGY",constr_homology + do k=1,constr_homology + + read(inp,'(a)') pdbfile + write (iout,*) "k ",k," pdbfile ",pdbfile +c Next stament causes error upon compilation (?) +c if(me.eq.king.or. .not. out1file) +c write (iout,'(2a)') 'PDB data will be read from file ', +c & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=33) + goto 34 + 33 write (iout,'(a)') 'Error opening PDB file.' + stop + 34 continue +c print *,'Begin reading pdb data' +c +c Files containing res sim or local scores (former containing sigmas) +c + + write(kic2,'(bz,i2.2)') k + + tpl_k_rescore="template"//kic2//".sco" +c tpl_k_sigma_odl="template"//kic2//".sigma_odl" +c tpl_k_sigma_dih="template"//kic2//".sigma_dih" +c tpl_k_sigma_theta="template"//kic2//".sigma_theta" +c tpl_k_sigma_d="template"//kic2//".sigma_d" + + unres_pdb=.false. + call readpdb + do i=1,2*nres + do j=1,3 + crefjlee(j,i)=c(j,i) + enddo + enddo +#ifdef DEBUG + do i=1,nres + write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3), + & (crefjlee(j,i+nres),j=1,3) + enddo +#endif + write (iout,*) "READ HOMOLOGY INFO" + write (iout,*) "read_constr_homology x: after reading pdb file" + write (iout,*) "waga_homology(",iset,")",waga_homology(iset) + write (iout,*) "waga_dist",waga_dist + write (iout,*) "waga_angle",waga_angle + write (iout,*) "waga_theta",waga_theta + write (iout,*) "waga_d",waga_d + write (iout,*) "dist_cut",dist_cut + call flush(iout) + +c +c Distance restraints +c +c ... --> odl(k,ii) +C Copy the coordinates from reference coordinates (?) + do i=1,2*nres + do j=1,3 + c(j,i)=cref(j,i) +c write (iout,*) "c(",j,i,") =",c(j,i) + enddo + enddo +c +c From read_dist_constr (commented out 25/11/2014 <-> res sim) +c +c write(iout,*) "tpl_k_rescore - ",tpl_k_rescore + open (ientin,file=tpl_k_rescore,status='old') + do irec=1,maxdim ! loop for reading res sim + if (irec.eq.1) then + rescore(k,irec)=0.0d0 + goto 1301 + endif + read (ientin,*,end=1401) rescore_tmp +c rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values + rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores +c write(iout,*) "rescore(",k,irec,") =",rescore(k,irec) + 1301 continue + enddo + 1401 continue + close (ientin) +c open (ientin,file=tpl_k_sigma_odl,status='old') +c do irec=1,maxdim ! loop for reading sigma_odl +c read (ientin,*,end=1401) i, j, +c & sigma_odl_temp(i+nnt-1,j+nnt-1,k) ! new variable (?) +c sigma_odl_temp(j+nnt-1,i+nnt-1,k)= ! which purpose? +c & sigma_odl_temp(i+nnt-1,j+nnt-1,k) +c enddo +c 1401 continue +c close (ientin) + if (waga_dist.ne.0.0d0) then + ii=0 + do i = nnt,nct-2 ! right? without parallel. + do j=i+2,nct ! right? +c do i = 1,nres ! alternative for bounds as used to set initial values in orig. read_constr_homology +c do j=i+2,nres ! ibid +c do i = nnt,nct-2 ! alternative for bounds as used to assign dist restraints in orig. read_constr_homology (s. above) +c do j=i+2,nct ! ibid + ii=ii+1 +c write (iout,*) "k",k +c write (iout,*) "i",i," j",j," constr_homology", +c & constr_homology + ires_homo(ii)=i + jres_homo(ii)=j +c +c Attempt to replace dist(i,j) by its definition in ... +c + x12=c(1,i)-c(1,j) + y12=c(2,i)-c(2,j) + z12=c(3,i)-c(3,j) + distal=dsqrt(x12*x12+y12*y12+z12*z12) + odl(k,ii)=distal +c +c odl(k,ii)=dist(i,j) +c write (iout,*) "dist(",i,j,") =",dist(i,j) +c write (iout,*) "distal = ",distal +c write (iout,*) "odl(",k,ii,") =",odl(k,ii) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,j,") =",rescore(k,j) +c +c Calculation of sigma from res sim +c +c if (odl(k,ii).le.6.0d0) then +c sigma_odl(k,ii)=hmscore(k)*rescore(k,i)*rescore(k,j) +c Other functional forms possible depending on odl(k,ii), eg. +c + if (odl(k,ii).le.dist_cut) then + sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) ! other exprs possible +c sigma_odl(k,ii)=hmscore(k)*rescore(k,i)*rescore(k,j) + else + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* ! sigma ~ rescore ~ error + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2) + +c Following expr replaced by a positive exp argument +c sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* +c & dexp(-0.5d0*(odl(k,ii)/dist_cut)**2) + +c sigma_odl(k,ii)=hmscore(k)*rescore(k,i)*rescore(k,j)* +c & dexp(-0.5d0*(odl(k,ii)/dist_cut)**2) + endif +c + sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) ! rescore ~ error +c sigma_odl(k,ii)=sigma_odl(k,ii)*sigma_odl(k,ii) +c +c sigma_odl(k,ii)=sigma_odl_temp(i,j,k)* ! new var read from file (?) +c & sigma_odl_temp(i,j,k) ! not inverse because of use of res. similarity + enddo +c read (ientin,*) sigma_odl(k,ii) ! 1st variant + enddo +c lim_odl=ii +c if (constr_homology.gt.0) call homology_partition + endif +c +c Theta, dihedral and SC retraints +c + if (waga_angle.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_dih,status='old') +c do irec=1,maxres-3 ! loop for reading sigma_dih +c read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for? +c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right? +c sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_dih(k,i+nnt-1) +c enddo +c1402 continue +c close (ientin) + do i = nnt+3,nct ! right? without parallel. +c do i=1,nres ! alternative for bounds acc to readpdb? +c do i=1,nres-3 ! alternative for bounds as used to set initial values in orig. read_constr_homology +c do i=idihconstr_start_homo,idihconstr_end_homo ! with FG parallel. + dih(k,i)=phiref(i) ! right? +c read (ientin,*) sigma_dih(k,i) ! original variant +c write (iout,*) "dih(",k,i,") =",dih(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2), +c & "rescore(",k,i-3,") =",rescore(k,i-3) + + sigma_dih(k,i)=rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2)+rescore(k,i-3) ! right expression ? +c +c write (iout,*) "Raw sigmas for dihedral angle restraints" +c write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i) +c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2)*rescore(k,i-3) ! right expression ? +c Instead of res sim other local measure of b/b str reliability possible + sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) +c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i) + if (i-nnt-2.gt.lim_dih) lim_dih=i-nnt-2 ! right? +c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! original when readin i from file + enddo + endif + + if (waga_theta.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_theta,status='old') +c do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for? +c sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_theta(k,i+nnt-1) +c enddo +c1403 continue +c close (ientin) + + do i = nnt+2,nct ! right? without parallel. +c do i = i=1,nres ! alternative for bounds acc to readpdb? +c do i=ithet_start,ithet_end ! with FG parallel. + thetatpl(k,i)=thetaref(i) +c write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2) +c read (ientin,*) sigma_theta(k,i) ! 1st variant + sigma_theta(k,i)=rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2) ! right expression ? + sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + +c sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2) ! right expression ? +c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i) + if (i-nnt-1.gt.lim_theta) lim_theta=i-nnt-1 ! right? + enddo + endif + + if (waga_d.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_d,status='old') +c do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for? +c sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_d(k,i+nnt-1) +c enddo +c1404 continue + close (ientin) + + do i = nnt,nct ! right? without parallel. +c do i=2,nres-1 ! alternative for bounds acc to readpdb? +c do i=loc_start,loc_end ! with FG parallel. + if (itype(i).eq.10) goto 1 ! right? + xxtpl(k,i)=xxref(i) + yytpl(k,i)=yyref(i) + zztpl(k,i)=zzref(i) +c write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i) +c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i) +c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i) + sigma_d(k,i)=rescore(k,i) ! right expression ? + sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) + +c sigma_d(k,i)=hmscore(k)*rescore(k,i) ! right expression ? +c sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i) +c read (ientin,*) sigma_d(k,i) ! 1st variant + if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 ! right? + 1 continue + enddo + endif + close(ientin) + enddo + if (waga_dist.ne.0.0d0) lim_odl=ii + if (constr_homology.gt.0) call homology_partition + if (constr_homology.gt.0) call init_int_table +cd write (iout,*) "homology_partition: lim_theta= ",lim_theta, +cd & "lim_xx=",lim_xx +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +c +c Print restraints +c + if (.not.lprn) return +cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write (iout,*) "Distance restraints from templates" + do ii=1,lim_odl + write(iout,'(3i5,10(2f16.2,4x))') ii,ires_homo(ii),jres_homo(ii), + & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),ki=1,constr_homology) + enddo + write (iout,*) "Dihedral angle restraints from templates" + do i=nnt+3,lim_dih + write (iout,'(i5,10(2f8.2,4x))') i,(rad2deg*dih(ki,i), + & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "Virtual-bond angle restraints from templates" + do i=nnt+2,lim_theta + write (iout,'(i5,10(2f8.2,4x))') i,(rad2deg*thetatpl(ki,i), + & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "SC restraints from templates" + do i=nnt,lim_xx + write(iout,'(i5,10(4f8.2,4x))') i, + & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i), + & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology) + enddo + endif +c ----------------------------------------------------------------- + return + end + + diff --git a/source/cluster/wham/src/sizesclu.dat b/source/cluster/wham/src/sizesclu.dat index 1810f0c..531d2f7 100644 --- a/source/cluster/wham/src/sizesclu.dat +++ b/source/cluster/wham/src/sizesclu.dat @@ -5,7 +5,7 @@ * Max. number of conformations in the data set. * integer maxconf,maxstr_proc - PARAMETER (MAXCONF=13000) + PARAMETER (MAXCONF=10000) parameter (maxstr_proc=maxconf/2) * * Max. number of "distances" between conformations. diff --git a/source/unres/src_MD/cinfo.f b/source/unres/src_MD/cinfo.f index a688eb6..55ee9cc 100644 --- a/source/unres/src_MD/cinfo.f +++ b/source/unres/src_MD/cinfo.f @@ -1,10 +1,10 @@ C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C -C 0 40376 53 +C 0 40376 57 subroutine cinfo include 'COMMON.IOUNITS' write(iout,*)'++++ Compile info ++++' - write(iout,*)'Version 0.40376 build 53' - write(iout,*)'compiled Fri Mar 6 10:04:56 2015' + write(iout,*)'Version 0.40376 build 57' + write(iout,*)'compiled Thu Mar 26 15:19:33 2015' write(iout,*)'compiled by felipe@piasek4' write(iout,*)'OS name: Linux ' write(iout,*)'OS release: 3.2.0-70-generic ' diff --git a/source/unres/src_MD/energy_p_new_barrier.F b/source/unres/src_MD/energy_p_new_barrier.F index d07d135..9481003 100644 --- a/source/unres/src_MD/energy_p_new_barrier.F +++ b/source/unres/src_MD/energy_p_new_barrier.F @@ -4862,6 +4862,8 @@ C & sinph1ph2(maxdouble,maxdouble) logical lprn /.false./, lprn1 /.false./ etheta=0.0D0 + write (iout,*) "EBEND ithet_start",ithet_start, + & " ithet_end",ithet_end do i=ithet_start,ithet_end if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. &(itype(i).eq.ntyp1)) cycle diff --git a/source/unres/src_MD/initialize_p.F b/source/unres/src_MD/initialize_p.F index 2d08087..369e6bc 100644 --- a/source/unres/src_MD/initialize_p.F +++ b/source/unres/src_MD/initialize_p.F @@ -562,6 +562,7 @@ C Partition local interactions call int_bounds(nres-2,ithet_start,ithet_end) ithet_start=ithet_start+2 ithet_end=ithet_end+2 + write (iout,*) "ithet_start",ithet_start," ithet_end",ithet_end call int_bounds(nct-nnt-2,iturn3_start,iturn3_end) iturn3_start=iturn3_start+nnt iphi_start=iturn3_start+2 diff --git a/source/wham/src/CMakeLists.txt b/source/wham/src/CMakeLists.txt index e7f990e..4035b15 100644 --- a/source/wham/src/CMakeLists.txt +++ b/source/wham/src/CMakeLists.txt @@ -97,8 +97,6 @@ if (Fortran_COMPILER_NAME STREQUAL "ifort") set(FFLAGS0 "-mcmodel=medium -g -CB -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") set(FFLAGS0 "-std=legacy -g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) -else () - set(FFLAGS0 "-g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) endif (Fortran_COMPILER_NAME STREQUAL "ifort") @@ -106,7 +104,7 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags #========================================= if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_WHAM_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -221,24 +219,19 @@ set(UNRES_WHAM_SRCS ${UNRES_WHAM_SRC0} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f proc_ #========================================= add_executable(UNRES_WHAM_BIN ${UNRES_WHAM_SRCS} ) set_target_properties(UNRES_WHAM_BIN PROPERTIES OUTPUT_NAME ${UNRES_WHAM_BIN}) -set_property(TARGET UNRES_WHAM_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) + +#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) #========================================= # Link libraries #========================================= -# link MPI libraries -target_link_libraries( UNRES_WHAM_BIN ${MPI_Fortran_LIBRARIES} ) +# link MPI library (libmpich.a) +target_link_libraries( UNRES_WHAM_BIN ${MPIF_LIBRARIES} ) # link libxdrf.a target_link_libraries( UNRES_WHAM_BIN xdrf ) #========================================= -# Install Path -#========================================= -install(TARGETS UNRES_WHAM_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}) - - -#========================================= # TESTS #========================================= diff --git a/source/wham/src/COMMON.CHAIN b/source/wham/src/COMMON.CHAIN index 07dd87e..0d4054c 100644 --- a/source/wham/src/COMMON.CHAIN +++ b/source/wham/src/COMMON.CHAIN @@ -1,8 +1,9 @@ integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq,ishift_pdb - double precision c,cref,dc,xloc,xrot,dc_norm,t,r,prod,rt + double precision c,cref,crefjlee,dc,xloc,xrot,dc_norm,t,r,prod,rt + common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), & xrot(3,maxres),dc_norm(3,maxres2),nres,nres0 common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),nsup,nstart_sup,nend_sup, - & nstart_seq,ishift_pdb + common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2), + & nsup,nstart_sup,nend_sup,nstart_seq,ishift_pdb diff --git a/source/wham/src/COMMON.CONTROL b/source/wham/src/COMMON.CONTROL index 594cd80..ed0f98b 100644 --- a/source/wham/src/COMMON.CONTROL +++ b/source/wham/src/COMMON.CONTROL @@ -1,9 +1,15 @@ integer iscode,indpdb,outpdb,outmol2,icomparfunc,pdbint, - & ensembles,constr_dist + & ensembles,constr_dist,constr_homology,homol_nset, + & iset + real*8 waga_homology + real*8 waga_dist, waga_angle, waga_theta, waga_d, dist_cut logical refstr,pdbref,punch_dist,print_rms,caonly,verbose, & merge_helices,bxfile,cxfile,histfile,entfile,zscfile, - & rmsrgymap,with_dihed_constr,check_conf,histout + & rmsrgymap,with_dihed_constr,check_conf,histout,out1file common /cntrl/ iscode,indpdb,refstr,pdbref,outpdb,outmol2, & punch_dist,print_rms,caonly,verbose,icomparfunc,pdbint, & merge_helices,bxfile,cxfile,histfile,entfile,zscfile,rmsrgymap, - & ensembles,with_dihed_constr,check_conf,histout,constr_dist + & ensembles,with_dihed_constr,check_conf,histout,constr_dist, + & constr_homology,out1file,homol_nset + common /homol/ waga_homology(MaxProcs/20), + & waga_dist,waga_angle,waga_theta,waga_d,dist_cut,iset diff --git a/source/wham/src/COMMON.DFA b/source/wham/src/COMMON.DFA new file mode 100644 index 0000000..c6add4f --- /dev/null +++ b/source/wham/src/COMMON.DFA @@ -0,0 +1,101 @@ +C ======= +C COMMON.DFA +C ======= +C 2010/12/20 By Juyong Lee +C +c parameter +C [ 8 * ( Nres - 8 ) ] distance restraints +C [ 2 * ( Nres - 8 ) ] angle restraints +C [ Nres ] neighbor restraints +C Total : ~ 11 * Nres restraints +C +C + INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN + PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) + PARAMETER(MAXN=4) + real*8 wwdist,wwangle,wwnei + parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) + +C IDFAMAX - maximum number of DFA restraint including distance, angle and +C number of neighbors ( Max of assign statement ) +C IDFAMX2 - maximum number of atoms which are targets of restraints +C IDFACMD - maximum number of 'DFA' command call +C IDMAXMIN - Maximum number of minima of dist, angle and neighbor info. from fragments +C MAXN - Maximum Number of shell, currently 4 +C MAXRES - Maximum number of CAs + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc +C INTEGER +C DFANUM - Number of ALL DFA restrants +c IDFA[DIS, PHI, THE, NEI] - NUMBER of restraints +c IDISNUM - number of minima for a distance restraint +c IPHINUM - number of minima for a phi angle restraint +c ITHENUM - number of minima for a theta angle restraint +c INEINUM - number of minima for a number of neighbors restraint + +c IDISLIS - atom number of two atoms for distance restraint +c IPHILIS - atom numbers of four atoms for angle restraint +c ITHELIS - atom numbers of four atoms for angle restraint +c INEILIS - atom number of center of neighbor calculation +c JNEILIS - atom number of target of neighboring calculation +c JNEINUM - number of target atoms of neighboring term +C KSHELL - SHELL number + +C ishiftca - index shift for CA atoms in UNRES (1 if the 1st aa != GLY) +C ilastca - index of the last CA atom in UNRES (nres-1 if last aa != GLY) + +C old only for CHARMM +C STOAGDF - Store assign information ( How many assign within one command ) +C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei + + INTEGER IDFADIS,IDFAPHI,IDFATHE,IDFANEI, + & IDISLIS,IPHILIS,ITHELIS,INEILIS, + & IDISNUM,IPHINUM,ITHENUM,INEINUM, + & FNEI,DFACMD, DFANUM, + & NCA,ICAIDX, + & STOAGDF, NMAP, IDFACAT, KDISNUM, KSHELL + & ishiftca,ilastca + COMMON /IDFA/ DFACMD, DFANUM, + & IDFADIS, IDFAPHI, IDFANEI, IDFATHE, + & IDISNUM(IDFAMAX), IPHINUM(IDFAMAX), + & ITHENUM(IDFAMAX), INEINUM(IDFAMAX), + & FNEI(IDFAMAX,IDMAXMIN), IDISLIS(2,IDFAMAX), + & IPHILIS(5,IDFAMAX), ITHELIS(5,IDFAMAX), + & INEILIS(IDFAMAX), + & KSHELL(IDFAMAX), + & IDFACAT(IDFACMD), + & KDISNUM(IDFAMAX), + & NCA, ICAIDX(MAXRES) + COMMON /IDFA2/ ishiftca,ilastca + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +C +C REAL VARIABLES +C +c SCC[DIST, PHI, THE] - weight of each calculations +c FDIST - distance minima +C FPHI - phi minima +c FTHE - theta minima +C DFAEXP : calculate expential function in advance +C + REAL*8 SCCDIST, SCCPHI, SCCTHE, SCCNEI, FDIST, FPHI1, FPHI2, + & FTHE1, FTHE2, + & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, + & WSHET, EDFABET, + & CK, SCK, S1, S2 +c & ,DFAEXP + + COMMON /RDFA/ SCCDIST(IDFAMAX,IDMAXMIN),FDIST(IDFAMAX,IDMAXMIN), + & SCCPHI(IDFAMAX,IDMAXMIN), SCCTHE(IDFAMAX,IDMAXMIN), + & SCCNEI(IDFAMAX,IDMAXMIN), + & FPHI1(IDFAMAX,IDMAXMIN), FPHI2(IDFAMAX,IDMAXMIN), + & FTHE1(IDFAMAX,IDMAXMIN), FTHE2(IDFAMAX,IDMAXMIN), + & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, + & WSHET(MAXRES,MAXRES), EDFABET, + & CK(4),SCK(4),S1(4),S2(4) +c & ,DFAEXP(15001), + + DATA CK/1.0D0,1.58740105197D0,2.08008382305D0,2.51984209979D0/ + DATA SCK/1.0D0,1.25992104989D0,1.44224957031D0,1.58740105197D0/ + DATA S1/3.75D0,5.75D0,7.75D0,9.75D0/ + DATA S2/4.25D0,6.25D0,8.25D0,10.25D0/ diff --git a/source/wham/src/COMMON.DISTFIT b/source/wham/src/COMMON.DISTFIT new file mode 100644 index 0000000..683228a --- /dev/null +++ b/source/wham/src/COMMON.DISTFIT @@ -0,0 +1,14 @@ +c parameter (maxres22=maxres*(maxres+1)/2) + parameter (maxres22=1) + double precision w,d0,DRDG,DD,H,XX + integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0, + 1 lvar_frag,svar_frag,avar_frag + COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3) +csa COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3), +csa 1 lvar_frag(mxio,3),svar_frag(mxio,3), +csa 2 avar_frag(mxio,5) + COMMON /WAGI/ w(MAXRES22),d0(MAXRES22) + COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22), + 1 H(MAXRES,MAXRES),XX(MAXRES) + COMMON /frozen/ mask(maxres) + COMMON /store0/ nhpb0 diff --git a/source/wham/src/COMMON.HOMRESTR b/source/wham/src/COMMON.HOMRESTR new file mode 100644 index 0000000..5c23caf --- /dev/null +++ b/source/wham/src/COMMON.HOMRESTR @@ -0,0 +1,39 @@ + real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), + & dih(max_template,maxres),sigma_dih(max_template,maxres), + & sigma_odlir(max_template,maxdim) +c +c Specification of new variables used in subroutine e_modeller +c modified by FP (Nov.,2014) + real*8 xxtpl(max_template,maxres),yytpl(max_template,maxres), + & zztpl(max_template,maxres),thetatpl(max_template,maxres), + & sigma_theta(max_template,maxres), + & sigma_d(max_template,maxres) +c + + integer ires_homo(maxdim),jres_homo(maxdim) + + double precision + & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, + & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), + & dutheta(maxres),dugamma(maxres), + & duscdiff(3,maxres), + & duscdiffx(3,maxres), + & uconst_back + integer lim_odl,lim_dih,link_start_homo,link_end_homo, + & idihconstr_start_homo,idihconstr_end_homo +c +c FP (30/10/2014) +c +c integer ithetaconstr_start_homo,ithetaconstr_end_homo +c + integer nresn,nyosh,nnos + common /back_constr/ uconst_back,uscdiff, + & dutheta,dugamma,duscdiff,duscdiffx + common /homrestr/ odl,dih,sigma_dih,sigma_odl, + & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo, + & link_end_homo,idihconstr_start_homo,idihconstr_end_homo, +c +c FP (30/10/2014,04/03/2015) +c + & xxtpl,yytpl,zztpl,thetatpl,sigma_theta,sigma_d,sigma_odlir +c diff --git a/source/wham/src/COMMON.VAR b/source/wham/src/COMMON.VAR index 2b11894..dfc1724 100644 --- a/source/wham/src/COMMON.VAR +++ b/source/wham/src/COMMON.VAR @@ -1,17 +1,26 @@ C Store the geometric variables in the following COMMON block. - integer ntheta,nphi,nside,nvar,ialph,ivar - double precision theta,phi,alph,omeg,vbld,vbld_ref, - & theta_ref,phi_ref,alph_ref,omeg_ref, - & costtab,sinttab,cost2tab,sint2tab, - & xxtab,yytab,zztab,tauangle,omicron + integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar, + & mask_theta,mask_phi,mask_side + double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, + & vbld_ref,theta_ref,phi_ref,alph_ref,omeg_ref, + & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, + & xxtab,yytab,zztab,xxref,yyref,zzref,omicron,tauangle common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), & omicron(2,maxres),tauangle(3,maxres), - & vbld(2*maxres), + & vbld(2*maxres),thetaref(maxres),phiref(maxres), & costtab(maxres), sinttab(maxres), cost2tab(maxres), & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres), + & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar C Angles from experimental structure common /varref/ vbld_ref(maxres), & theta_ref(maxres),phi_ref(maxres), & alph_ref(maxres),omeg_ref(maxres) +C Store the angles and variables corresponding to old conformations (for use +C in MCM). + common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave), + & Origin(maxsave),nstore +C freeze some variables + logical mask_r + common /restr/ varall(maxvar),mask_r,mask_theta(maxres), + & mask_phi(maxres),mask_side(maxres) diff --git a/source/wham/src/DIMENSIONS b/source/wham/src/DIMENSIONS index 281c414..f5438bc 100644 --- a/source/wham/src/DIMENSIONS +++ b/source/wham/src/DIMENSIONS @@ -6,7 +6,7 @@ ******************************************************************************** c implicit real*8 (a-h,o-z) C Max. number of processors. -C parameter (maxprocs=128) +c parameter (maxprocs=128) C Max. number of fine-grain processors C parameter (max_fg_procs=maxprocs) C Max. number of coarse-grain processors @@ -140,3 +140,6 @@ C Maximum number of SC local term fitting function coefficiants C Maximum number of terms in SC bond-stretching potential integer maxbondterm parameter (maxbondterm=3) +C Maximum number of templates in homology-modeling restraints + integer max_template + parameter(max_template=19) diff --git a/source/wham/src/DIMENSIONS.ZSCOPT b/source/wham/src/DIMENSIONS.ZSCOPT index bba6a76..755ac58 100644 --- a/source/wham/src/DIMENSIONS.ZSCOPT +++ b/source/wham/src/DIMENSIONS.ZSCOPT @@ -3,7 +3,7 @@ c Maximum number of structures in the database, energy components, proteins, c and structural classes c#ifdef JUBL - parameter (maxstr=2000000,max_ene=21,maxprot=7,maxclass=5000) + parameter (maxstr=2000000,max_ene=27,maxprot=7,maxclass=5000) parameter (maxclass1=10) c Maximum number of structures to be dealt with by one processor parameter (maxstr_proc=20000) diff --git a/source/wham/src/Makefile-pgi b/source/wham/src/Makefile-pgi new file mode 100644 index 0000000..40cc442 --- /dev/null +++ b/source/wham/src/Makefile-pgi @@ -0,0 +1,74 @@ +BIN = /users/adam/ZSCOREZ/bin +CC = cc +FC = mpif90 +#FC = ifc +OPT = -fast -pc 64 -tp p6 -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 +#FFLAGS = ${OPT} -g -c -I. -I./include_unres +#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres +FFLAGS = ${OPT} -c -I. -I./include_unres +LIBS = -L../../MEY_MD/src_Tc/xdrf -lxdrf +#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} -Wl,-Bstatic ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_multparm-T-sccor + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile1_jump b/source/wham/src/Makefile1_jump new file mode 100644 index 0000000..1df1586 --- /dev/null +++ b/source/wham/src/Makefile1_jump @@ -0,0 +1,60 @@ +BIN = ../bin +CC = cc +FC = mpxlf90 -qfixed -w +OPT = -q64 +FFLAGS = -c ${OPT} -O3 -I./include_unres +LIBS = xdrf/libxdrf.o xdrf/ftocstr.o +CPPFLAGS = -WF,-DMPI -WF,-DAIX -WF,-DUNRES -WF,-DSPLITELE -WF,-DPROCOR -WF,-DISNAN + +.SUFFIXES: .F +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + rescode.o \ + setup_var.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_multparm1-T-procor + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_0 b/source/wham/src/Makefile_0 new file mode 100644 index 0000000..a05ef29 --- /dev/null +++ b/source/wham/src/Makefile_0 @@ -0,0 +1,82 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +BIN = ../../../bin/wham +FC= ifort +#OPT = -O3 -ip -w +OPT = -g -CB +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + gnmr1.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o \ + dfa.o \ + ssMD.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM +GAB: ${objects} ${objects_compar} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_ifort_MPICH-restr-DFA_GAB.exe + +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -DWHAM +E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH-restr-DFA_E0LL2Y.exe + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + diff --git a/source/wham/src/Makefile_MPICH_ifort b/source/wham/src/Makefile_MPICH_ifort index 7ef235d..6e2ba17 100644 --- a/source/wham/src/Makefile_MPICH_ifort +++ b/source/wham/src/Makefile_MPICH_ifort @@ -46,6 +46,7 @@ objects = \ store_parm.o \ timing.o \ wham_calc1.o \ + dfa.o \ ssMD.o objects_compar = \ @@ -55,11 +56,6 @@ objects_compar = \ angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o -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 GAB: ${objects} ${objects_compar} xdrf/libxdrf.a @@ -67,16 +63,7 @@ GAB: ${objects} ${objects_compar} xdrf/libxdrf.a ./compinfo ${FC} -c ${FFLAGS} cinfo.f $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_GAB.exe - -4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM -4P: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_4P.exe + ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH-restr-DFA_GAB.exe E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -DWHAM E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a @@ -84,7 +71,7 @@ E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a ./compinfo ${FC} -c ${FFLAGS} cinfo.f $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_E0LL2Y.exe + ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH-restr-DFA_E0LL2Y.exe xdrf/libxdrf.a: cd xdrf && make diff --git a/source/wham/src/Makefile_MPICH_pgi b/source/wham/src/Makefile_MPICH_pgi deleted file mode 100644 index 02396d0..0000000 --- a/source/wham/src/Makefile_MPICH_pgi +++ /dev/null @@ -1,97 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -CC = cc -FC = pgf90 -#OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -C -g -OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - gnmr1.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o \ - ssMD.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -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 -GAB: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_pgf90_MPICH_GAB.exe - -4P: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPGI -DISNAN -DAMD64 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DWHAM -4P: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_pgf90_MPICH_4P.exe - -E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -DWHAM -E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_pgf90_MPICH_E0LL2Y.exe - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - diff --git a/source/wham/src/Makefile_jubl b/source/wham/src/Makefile_jubl new file mode 100644 index 0000000..5f37ee7 --- /dev/null +++ b/source/wham/src/Makefile_jubl @@ -0,0 +1,95 @@ +CPPFLAGS = -WF,-DOLD_GINV \ + -WF,-DUNRES -WF,-DMPI \ + -WF,-DSPLITELE -WF,-DISNAN \ + -WF,-DAIX -WF,-DLANG0 -WF,-DPROCOR -WF,-DJUBL +#-WF,-DNOXDR +#-WF,-DPROCOR +## -DMOMENT +#-DCO_BIAS +#-DCRYST_TOR +#-DDEBUG + +BGLSYS = /bgl/BlueLight/ppcfloor/bglsys + +CC = /usr/bin/blrts_xlc +CPPC = /usr/bin/blrts_xlc +FC = /usr/bin/blrts_xlf90 +#-pg -g + +# try -qarch=440 first, then use -qarch=440d for 2nd FPU later on +# (SIMDization requires at least -O3) +# use -qlist -qsource with 440d and look for Parallel ASM instructions. +# +OPT= -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -qfixed -w -qnosave +CFLAGS= -O3 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 +FFLAGS= -c -O3 ${OPT} -I./include_unres +# +LIBS_MPI = -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts +LIBSF_MPI = -lmpich.rts -lfmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts + +FFLAGS1 = -c ${OPT} -O2 +FFLAGS2 = -c ${OPT} -O +FFLAGSE = -c ${OPT} -O4 + + +BIN = ${HOME}/UNRES/bin/wham_multparm-T-procor.rts +LIBS = ${LIBSF_MPI} ../src_Tc/xdrf/libxdrf.a +#LIBS = ${LIBSF_MPI} + +ARCH = LINUX +PP = /lib/cpp -P + +all: unresCSA + +.SUFFIXES: .F +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + + +objects = \ + wham_multparm.o \ + cxread.o \ + enecalc.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + rescode.o \ + setup_var.o \ + store_parm.o \ + timing.o \ + wham_calc.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + + +unresCSA: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${objects} ${objects_compar} cinfo.o ${LIBS} -o ${BIN} + + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_jump b/source/wham/src/Makefile_jump new file mode 100644 index 0000000..e79c218 --- /dev/null +++ b/source/wham/src/Makefile_jump @@ -0,0 +1,69 @@ +BIN = ../bin +CC = cc +CFLAGS = -DAIX -c +FC = mpxlf90 -qlistopt -qfixed -w +OPT = -q64 +FFLAGS = -c ${OPT} -O3 -I./include_unres +#FFLAGS = -c ${OPT} -g -C -I./include_unres +LIBS = xdrf/libxdrf.o xdrf/ftocstr.o +CPPFLAGS = -WF,-DMPI -WF,-DAIX -WF,-DUNRES -WF,-DSPLITELE -WF,-DPROCOR -WF,-DISNAN + +.SUFFIXES: .F +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +.SUFFIXES: .c +.c.o: + ${CC} ${CFLAGS} $*.c + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_multparm-T-procor-c1 + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix b/source/wham/src/Makefile_matrix new file mode 100644 index 0000000..d16bc8c --- /dev/null +++ b/source/wham/src/Makefile_matrix @@ -0,0 +1,67 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +BIN = ../bin +FC= ifort +#OPT = -mcmodel=medium -O3 -ip -w +OPT = -mcmodel=medium -g -CB +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -static-intel -o ${BIN}/wham_multparm-ham_rep + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI b/source/wham/src/Makefile_matrix_PGI new file mode 100644 index 0000000..bb4982d --- /dev/null +++ b/source/wham/src/Makefile_matrix_PGI @@ -0,0 +1,76 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh +BIN = ../bin +CC = cc +FC = pgf90 +#FC = ifc +#OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -C -g +OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 +#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include +#FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o -Bstatic_pgi \ + ${LIBS} -o ${BIN}/wham_multparm-hamrep-sep + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI-SCT-oldparm b/source/wham/src/Makefile_matrix_PGI-SCT-oldparm new file mode 100644 index 0000000..82001ca --- /dev/null +++ b/source/wham/src/Makefile_matrix_PGI-SCT-oldparm @@ -0,0 +1,76 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh +BIN = ../bin +CC = cc +FC = pgf90 +#FC = ifc +OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 +#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include +#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DFUNCT +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o -Bstatic_pgi \ + ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCT-sccor-oldparm + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI-SCTF-oldparm b/source/wham/src/Makefile_matrix_PGI-SCTF-oldparm new file mode 100644 index 0000000..66ebf03 --- /dev/null +++ b/source/wham/src/Makefile_matrix_PGI-SCTF-oldparm @@ -0,0 +1,76 @@ +INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh +BIN = ../bin +CC = cc +FC = pgf90 +#FC = ifc +OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 +#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include +#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DFUNCTH +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} -Bstatic_pgi cinfo.o \ + ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCTF-sccor-oldparm + +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI-oldparm b/source/wham/src/Makefile_matrix_PGI-oldparm new file mode 100644 index 0000000..1c9d56b --- /dev/null +++ b/source/wham/src/Makefile_matrix_PGI-oldparm @@ -0,0 +1,76 @@ +INSTALL_DIR = /usr/local/mpich-1.2.7p1_pgi64-6.2-3_ssh +BIN = ../bin +CC = cc +FC = pgf90 +#FC = ifc +OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 +#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 +#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include +#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV +CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA +#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI +#CPPFLAGS = -DMPI -DLINUX -DUNRES + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +all: make_dbase + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +make_dbase: ${objects} ${objects_compar} + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCTF-sccor-oldparm + +clean: + /bin/rm *.o diff --git a/source/wham/src/chainbuild.f b/source/wham/src/chainbuild.f deleted file mode 100644 index 26afd44..0000000 --- a/source/wham/src/chainbuild.f +++ /dev/null @@ -1,258 +0,0 @@ - subroutine chainbuild -C -C Build the virtual polypeptide chain. Side-chain centroids are moveable. -C As of 2/17/95. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - logical lprn -C Set lprn=.true. for debugging - lprn = .false. -C -C Define the origin and orientation of the coordinate system and locate the -C first three CA's and SC(2). -C - call orig_frame -* -* Build the alpha-carbon chain. -* - do i=4,nres - call locate_next_res(i) - enddo -C -C First and last SC must coincide with the corresponding CA. -C - do j=1,3 - dc(j,nres+1)=0.0D0 - dc_norm(j,nres+1)=0.0D0 - dc(j,nres+nres)=0.0D0 - dc_norm(j,nres+nres)=0.0D0 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo -* -* Temporary diagnosis -* - if (lprn) then - - call cartprint - write (iout,'(/a)') 'Recalculated internal coordinates' - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) - enddo - be=0.0D0 - if (i.gt.3) be=rad2deg*beta(i-3,i-2,i-1,i) - be1=rad2deg*beta(nres+i,i,maxres2,i+1) - alfai=0.0D0 - if (i.gt.2) alfai=rad2deg*alpha(i-2,i-1,i) - write (iout,1212) restyp(itype(i)),i,dist(i-1,i), - & alfai,be,dist(nres+i,i),rad2deg*alpha(nres+i,i,maxres2),be1 - enddo - 1212 format (a3,'(',i3,')',2(f10.5,2f10.2)) - - endif - - return - end -c------------------------------------------------------------------------- - subroutine orig_frame -C -C Define the origin and orientation of the coordinate system and locate -C the first three atoms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - cost=dcos(theta(3)) - sint=dsin(theta(3)) - t(1,1,1)=-cost - t(1,2,1)=-sint - t(1,3,1)= 0.0D0 - t(2,1,1)=-sint - t(2,2,1)= cost - t(2,3,1)= 0.0D0 - t(3,1,1)= 0.0D0 - t(3,2,1)= 0.0D0 - t(3,3,1)= 1.0D0 - r(1,1,1)= 1.0D0 - r(1,2,1)= 0.0D0 - r(1,3,1)= 0.0D0 - r(2,1,1)= 0.0D0 - r(2,2,1)= 1.0D0 - r(2,3,1)= 0.0D0 - r(3,1,1)= 0.0D0 - r(3,2,1)= 0.0D0 - r(3,3,1)= 1.0D0 - do i=1,3 - do j=1,3 - rt(i,j,1)=t(i,j,1) - enddo - enddo - do i=1,3 - do j=1,3 - prod(i,j,1)=0.0D0 - prod(i,j,2)=t(i,j,1) - enddo - prod(i,i,1)=1.0D0 - enddo - c(1,1)=0.0D0 - c(2,1)=0.0D0 - c(3,1)=0.0D0 - c(1,2)=vbld(2) - c(2,2)=0.0D0 - c(3,2)=0.0D0 - dc(1,1)=vbld(2) - dc(2,1)=0.0D0 - dc(3,1)=0.0D0 - dc_norm(1,1)=1.0D0 - dc_norm(2,1)=0.0D0 - dc_norm(3,1)=0.0D0 - do j=1,3 - dc_norm(j,2)=prod(j,1,2) - dc(j,2)=vbld(3)*prod(j,1,2) - c(j,3)=c(j,2)+dc(j,2) - enddo - call locate_side_chain(2) - return - end -c----------------------------------------------------------------------------- - subroutine locate_next_res(i) -C -C Locate CA(i) and SC(i-1) -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' -C -C Define the rotation matrices corresponding to CA(i) -C - theti=theta(i) - phii=phi(i) - cost=dcos(theti) - sint=dsin(theti) - cosphi=dcos(phii) - sinphi=dsin(phii) -* Define the matrices of the rotation about the virtual-bond valence angles -* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this -* program), R(i,j,k), and, the cumulative matrices of rotation RT - t(1,1,i-2)=-cost - t(1,2,i-2)=-sint - t(1,3,i-2)= 0.0D0 - t(2,1,i-2)=-sint - t(2,2,i-2)= cost - t(2,3,i-2)= 0.0D0 - t(3,1,i-2)= 0.0D0 - t(3,2,i-2)= 0.0D0 - t(3,3,i-2)= 1.0D0 - r(1,1,i-2)= 1.0D0 - r(1,2,i-2)= 0.0D0 - r(1,3,i-2)= 0.0D0 - r(2,1,i-2)= 0.0D0 - r(2,2,i-2)=-cosphi - r(2,3,i-2)= sinphi - r(3,1,i-2)= 0.0D0 - r(3,2,i-2)= sinphi - r(3,3,i-2)= cosphi - rt(1,1,i-2)=-cost - rt(1,2,i-2)=-sint - rt(1,3,i-2)=0.0D0 - rt(2,1,i-2)=sint*cosphi - rt(2,2,i-2)=-cost*cosphi - rt(2,3,i-2)=sinphi - rt(3,1,i-2)=-sint*sinphi - rt(3,2,i-2)=cost*sinphi - rt(3,3,i-2)=cosphi - call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1)) - do j=1,3 - dc_norm(j,i-1)=prod(j,1,i-1) - dc(j,i-1)=vbld(i)*prod(j,1,i-1) - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo -cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i-1),j=1,3),(c(j,i),j=1,3) -C -C Now calculate the coordinates of SC(i-1) -C - call locate_side_chain(i-1) - return - end -c----------------------------------------------------------------------------- - subroutine locate_side_chain(i) -C -C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i). -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - dimension xx(3) - -c dsci=dsc(itype(i)) -c dsci_inv=dsc_inv(itype(i)) - dsci=vbld(i+nres) - dsci_inv=vbld_inv(i+nres) - alphi=alph(i) - omegi=omeg(i) - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - xp= dsci*cosalphi - yp= dsci*sinalphi*cosomegi - zp=-dsci*sinalphi*sinomegi -* Now we have to rotate the coordinate system by 180-theta(i)/2 so as to get its -* X-axis aligned with the vector DC(*,i) - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - xx(1)= xp*cost2+yp*sint2 - xx(2)=-xp*sint2+yp*cost2 - xx(3)= zp -cd print '(a3,i3,3f10.5,5x,3f10.5)',restyp(itype(i)),i, -cd & xp,yp,zp,(xx(k),k=1,3) - do j=1,3 - xloc(j,i)=xx(j) - enddo -* Bring the SC vectors to the common coordinate system. - xx(1)=xloc(1,i) - xx(2)=xloc(2,i)*r(2,2,i-1)+xloc(3,i)*r(2,3,i-1) - xx(3)=xloc(2,i)*r(3,2,i-1)+xloc(3,i)*r(3,3,i-1) - do j=1,3 - xrot(j,i)=xx(j) - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i-1)*xx(k) - enddo - dc(j,nres+i)=rj - dc_norm(j,nres+i)=rj*dsci_inv - c(j,nres+i)=c(j,i)+rj - enddo - return - end diff --git a/source/wham/src/dfa.F b/source/wham/src/dfa.F new file mode 100644 index 0000000..576910c --- /dev/null +++ b/source/wham/src/dfa.F @@ -0,0 +1,3455 @@ + subroutine init_dfa_vars + + include 'DIMENSIONS' + include 'COMMON.INTERACT' + include 'COMMON.DFA' + + integer ii + +C Number of restraints + idisnum = 0 + iphinum = 0 + ithenum = 0 + ineinum = 0 + + idislis = 0 + iphilis = 0 + ithelis = 0 + ineilis = 0 + jneilis = 0 + jneinum = 0 + kshell = 0 + fnei = 0 +C For beta + nca = 0 + icaidx = 0 + +C real variables +CC WEIGHTS for each min + sccdist = 0.0d0 + fdist = 0.0d0 + sccphi = 0.0d0 + sccthe = 0.0d0 + sccnei = 0.0d0 + fphi1 = 0.0d0 + fphi2 = 0.0d0 + fthe1 = 0.0d0 + fthe2 = 0.0d0 +C energies + edfatot = 0.0d0 + edfadis = 0.0d0 + edfaphi = 0.0d0 + edfathe = 0.0d0 + edfanei = 0.0d0 + edfabet = 0.0d0 +C weights for each E term +C these should be identical with + dis_inc = 0.0d0 + phi_inc = 0.0d0 + the_inc = 0.0d0 + nei_inc = 0.0d0 + beta_inc = 0.0d0 + wshet = 0.0d0 +C precalculate exp table! +c dfaexp = 0.0d0 +c do ii = 1, 15001 +c dfaexp(ii) = exp(-ii*0.001d0 + 0.0005d0) +c end do + + ishiftca=nnt-1 + ilastca=nct + + print *,'ishiftca=',ishiftca,'ilastca=',ilastca + + return + end + + + subroutine read_dfa_info +C +C read fragment informations +C + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.IOUNITS' + include 'COMMON.CHAIN' + include 'COMMON.DFA' + + +C NOTE THAT FILENAMES are FIXED, CURRENTLY!! +C THIS SHOULD BE MODIFIED!! + + character*320 buffer + integer iodfa + parameter(iodfa=89) + + integer i, j, nval + integer ica1, ica2,ica3,ica4,ica5 + integer ishell, inca, itmp,iitmp + double precision wtmp +C +C READ DISTANCE +C + open(iodfa, file = 'dist_dfa.dat', status = 'old', err=33) + goto 34 + 33 write(iout,'(a)') 'Error opening dist_dfa.dat file' + stop + 34 continue + write(iout,'(a)') 'dist_dfa.dat is opened!' +C read title + read(iodfa, '(a)') buffer +C read number of restraints + read(iodfa, *) IDFADIS + read(iodfa, *) dis_inc + do i=1, idfadis + read(iodfa, '(i10,1x,i10,1x,i10)') ica1, ica2, nval + + idisnum(i)=nval + idislis(1,i)=ica1 + idislis(2,i)=ica2 + + do j=1, nval + read(iodfa,*) tmp + fdist(i,j) = tmp + enddo + + do j=1, nval + read(iodfa,*) tmp + sccdist(i,j) = tmp + enddo + + enddo + close(iodfa) + +C READ ANGLE RESTRAINTS +C PHI RESTRAINTS + open(iodfa, file='phi_dfa.dat',status='old',err=35) + goto 36 + 35 write(iout,'(a)') 'Error opening dist_dfa.dat file' + stop + + 36 continue + write(iout,'(a)') 'phi_dfa.dat is opened!' + +C READ TITLE + read(iodfa, '(a)') buffer +C READ NUMBER OF RESTRAINTS + READ(iodfa, *) IDFAPHI + read(iodfa,*) phi_inc + do i=1, idfaphi + read(iodfa,'(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval + + iphinum(i)=nval + + iphilis(1,i)=ica1 + iphilis(2,i)=ica2 + iphilis(3,i)=ica3 + iphilis(4,i)=ica4 + iphilis(5,i)=ica5 + + do j=1, nval + read(iodfa,*) tmp1,tmp2 + fphi1(i,j) = tmp1 + fphi2(i,j) = tmp2 + enddo + + do j=1, nval + read(iodfa,*) tmp + sccphi(i,j) = tmp + enddo + + enddo + close(iodfa) + +C THETA RESTRAINTS + open(iodfa, file='theta_dfa.dat',status='old',err=41) + goto 42 + 41 write(iout,'(a)') 'Error opening dist_dfa.dat file' + stop + 42 continue + write(iout,'(a)') 'theta_dfa.dat is opened!' +C READ TITLE + read(iodfa, '(a)') buffer +C READ NUMBER OF RESTRAINTS + READ(iodfa, *) IDFATHE + read(iodfa,*) the_inc + + do i=1, idfathe + read(iodfa, '(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval + + ithenum(i)=nval + + ithelis(1,i)=ica1 + ithelis(2,i)=ica2 + ithelis(3,i)=ica3 + ithelis(4,i)=ica4 + ithelis(5,i)=ica5 + + do j=1, nval + read(iodfa,*) tmp1,tmp2 + fthe1(i,j) = tmp1 + fthe2(i,j) = tmp2 + enddo + + do j=1, nval + read(iodfa,*) tmp + sccthe(i,j) = tmp + enddo + + enddo + close(iodfa) +C END of READING ANGLE RESTRAINT! + +C NUMBER OF NEIGHBOR CAs + open(iodfa,file='nei_dfa.dat',status='old',err=37) + goto 38 + 37 write(iout,'(a)') 'Error opening nei_dfa.dat file' + stop + 38 continue + write(iout,'(a)') 'nei_dfa.dat is opened!' +C READ TITLE + read(iodfa, '(a)') buffer +C READ NUMBER OF RESTRAINTS + READ(iodfa, *) idfanei + read(iodfa,*) nei_inc + + do i=1, idfanei + read(iodfa,'(2(i10,1x),i10)')ica1,ishell,nval + + ineilis(i)=ica1 + kshell(i)=ishell + ineinum(i)=nval + + do j=1, nval + read(iodfa,*) inca + fnei(i,j) = inca +C write(*,*) 'READ NEI:',i,j,fnei(i,j) + enddo + + do j=1, nval + read(iodfa,*) tmp + sccnei(i,j) = tmp + enddo + + enddo + close(iodfa) +C END OF NEIGHBORING CA + +C READ BETA RESTRAINT + open(iodfa, file='beta_dfa.dat',status='old',err=39) + goto 40 + 39 write(iout,'(a)') 'Error opening beta_dfa.dat file' + stop + 40 continue + write(iout,'(a)') 'beta_dfa.dat is opened!' + + read(iodfa,'(a)') buffer + read(iodfa,*) itmp + read(iodfa,*) beta_inc + + do i=1,itmp + read(iodfa,*) ica1, iitmp + do j=1,itmp + read(iodfa,*) wtmp + wshet(i,j) = wtmp +c write(*,*) 'BETA:',i,j,wtmp,wshet(i,j) + enddo + enddo + + close(iodfa) +C END OF BETA RESTRAINT + + return + END + + subroutine edfad(edfadis) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + double precision edfadis + integer i, iatm1, iatm2,idiff + double precision ckk, sckk,dist,texp + double precision jix,jiy,jiz,ep,fp,scc + + edfadis=0 + gdfad=0.0d0 + + do i=1, idfadis + + iatm1=idislis(1,i)+ishiftca + iatm2=idislis(2,i)+ishiftca + idiff = abs(iatm1-iatm2) + + JIX=c(1,iatm2)-c(1,iatm1) + JIY=c(2,iatm2)-c(2,iatm1) + JIZ=c(3,iatm2)-c(3,iatm1) + DIST=SQRT(JIX*JIX+JIY*JIY+JIZ*JIZ) + + ckk=ck(idiff) + sckk=sck(idiff) + + scc = 0.0d0 + ep = 0.0d0 + fp = 0.0d0 + + do j=1,idisnum(i) + + dd = dist-fdist(i,j) + dtmp = dd*dd/ckk + if (dtmp.ge.15.0d0) then + texp = 0.0d0 + else +c texp = dfaexp( idint(dtmp*1000)+1 )/sckk + texp = exp(-dtmp)/sckk + endif + + ep=ep+sccdist(i,j)*texp + fp=fp+sccdist(i,j)*texp*dd*2.0d0/ckk + scc=scc+sccdist(i,j) +C write(*,'(2i8,6f12.5)') i, j, dist, +C & fdist(i,j), ep, fp, sccdist(i,j), scc + + enddo + + ep = -ep/scc + fp = fp/scc + + +c IF(ABS(EP).lt.1.0d-20)THEN +c EP=0.0D0 +c ENDIF +c IF (ABS(FP).lt.1.0d-20) THEN +c FP=0.0D0 +c ENDIF + + edfadis=edfadis+ep*dis_inc*wwdist + + gdfad(1,iatm1) = gdfad(1,iatm1)-jix/dist*fp*dis_inc*wwdist + gdfad(2,iatm1) = gdfad(2,iatm1)-jiy/dist*fp*dis_inc*wwdist + gdfad(3,iatm1) = gdfad(3,iatm1)-jiz/dist*fp*dis_inc*wwdist + + gdfad(1,iatm2) = gdfad(1,iatm2)+jix/dist*fp*dis_inc*wwdist + gdfad(2,iatm2) = gdfad(2,iatm2)+jiy/dist*fp*dis_inc*wwdist + gdfad(3,iatm2) = gdfad(3,iatm2)+jiz/dist*fp*dis_inc*wwdist + + enddo + + return + end + + subroutine edfat(edfator) +C DFA torsion angle + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + integer i,j,ii,iii + integer iatom(5) + double precision aphi(2),athe(2),tdx(5),tdy(5),tdz(5) + double precision cwidth, cwidth2 + PARAMETER(CWIDTH=0.1D0,CWIDTH2=0.2D0,PAI=3.14159265358979323846D0) + + edfator= 0.0d0 + enephi = 0.0d0 + enethe = 0.0d0 + gdfat(:,:) = 0.0d0 + +C START OF PHI ANGLE + do i=1, idfaphi + + aphi = 0.0d0 + do iii=1,5 + iatom(iii)=iphilis(iii,i)+ishiftca + enddo + +C ANGLE VECTOR CALCULTION + RIX=C(1,IATOM(2))-C(1,IATOM(1)) + RIY=C(2,IATOM(2))-C(2,IATOM(1)) + RIZ=C(3,IATOM(2))-C(3,IATOM(1)) + + RIPX=C(1,IATOM(3))-C(1,IATOM(2)) + RIPY=C(2,IATOM(3))-C(2,IATOM(2)) + RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) + + RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) + RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) + RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) + + RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) + RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) + RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) + + GIX=RIY*RIPZ-RIZ*RIPY + GIY=RIZ*RIPX-RIX*RIPZ + GIZ=RIX*RIPY-RIY*RIPX + + GIPX=RIPY*RIPPZ-RIPZ*RIPPY + GIPY=RIPZ*RIPPX-RIPX*RIPPZ + GIPZ=RIPX*RIPPY-RIPY*RIPPX + + CIPX=C(1,IATOM(3))-C(1,IATOM(1)) + CIPY=C(2,IATOM(3))-C(2,IATOM(1)) + CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) + + CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) + CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) + CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) + + CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) + CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) + CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) + + DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) + DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) + DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) + DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) + +C END OF ANGLE VECTOR CALCULTION + + TDOT=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ + APHI(1)=TDOT/(DGI*DRIPP) + TDOT=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z + APHI(2)=TDOT/(DGIP*DRIP3) + + ephi = 0.0d0 + tfphi1=0.0d0 + tfphi2=0.0d0 + scc=0.0d0 + + do j=1, iphinum(i) + DDPS1=APHI(1)-FPHI1(i,j) + DDPS2=APHI(2)-FPHI2(i,j) + + DTMP = (DDPS1**2+DDPS2**2)/CWIDTH2 + + if (dtmp.ge.15.0d0) then + ps_tmp = 0.0d0 + else +c ps_tmp = dfaexp(idint(dtmp*1000)+1) + ps_tmp = exp(-dtmp) + endif + + ephi=ephi+sccphi(i,j)*ps_tmp + + tfphi1=tfphi1+sccphi(i,j)*ddps1/cwidth*ps_tmp + tfphi2=tfphi2+sccphi(i,j)*ddps2/cwidth*ps_tmp + + scc=scc+sccphi(i,j) +C write(*,'(2i8,8f12.6)')i,j,aphi(1),fphi1(i,j), +C & aphi(2),fphi2(i,j),tfphi1,tfphi2,ephi,sccphi(i,j) + ENDDO + + ephi=-ephi/scc*phi_inc*wwangle + tfphi1=tfphi1/scc*phi_inc*wwangle + tfphi2=tfphi2/scc*phi_inc*wwangle + + IF (ABS(EPHI).LT.1d-20) THEN + EPHI=0.0D0 + ENDIF + IF (ABS(TFPHI1).LT.1d-20) THEN + TFPHI1=0.0D0 + ENDIF + IF (ABS(TFPHI2).LT.1d-20) THEN + TFPHI2=0.0D0 + ENDIF + +C FORCE DIRECTION CALCULATION + TDX(1:5)=0.0D0 + TDY(1:5)=0.0D0 + TDZ(1:5)=0.0D0 + + DM1=1.0d0/(DGI*DRIPP) + + GIRPP=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ + DM2=GIRPP/(DGI**3*DRIPP) + DM3=GIRPP/(DGI*DRIPP**3) + + DM4=1.0d0/(DGIP*DRIP3) + + GIRP3=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z + DM5=GIRP3/(DGIP**3*DRIP3) + DM6=GIRP3/(DGIP*DRIP3**3) +C FIRST ATOM BY PHI1 + TDX(1)=(RIPZ*RIPPY-RIPY*RIPPZ)*DM1 + & +( GIZ* RIPY- GIY* RIPZ)*DM2 + TDY(1)=(RIPX*RIPPZ-RIPZ*RIPPX)*DM1 + & +( GIX* RIPZ- GIZ* RIPX)*DM2 + TDZ(1)=(RIPY*RIPPX-RIPX*RIPPY)*DM1 + & +( GIY* RIPX- GIX* RIPY)*DM2 + TDX(1)=TDX(1)*TFPHI1 + TDY(1)=TDY(1)*TFPHI1 + TDZ(1)=TDZ(1)*TFPHI1 +C SECOND ATOM BY PHI1 + TDX(2)=(CIPY*RIPPZ-CIPZ*RIPPY)*DM1 + & -(CIPY*GIZ-CIPZ*GIY)*DM2 + TDY(2)=(CIPZ*RIPPX-CIPX*RIPPZ)*DM1 + & -(CIPZ*GIX-CIPX*GIZ)*DM2 + TDZ(2)=(CIPX*RIPPY-CIPY*RIPPX)*DM1 + & -(CIPX*GIY-CIPY*GIX)*DM2 + TDX(2)=TDX(2)*TFPHI1 + TDY(2)=TDY(2)*TFPHI1 + TDZ(2)=TDZ(2)*TFPHI1 +C SECOND ATOM BY PHI2 + TDX(2)=TDX(2)+ + & ((RIPPZ*RIP3Y-RIPPY*RIP3Z)*DM4 + & +( GIPZ*RIPPY- GIPY*RIPPZ)*DM5)*TFPHI2 + TDY(2)=TDY(2)+ + & ((RIPPX*RIP3Z-RIPPZ*RIP3X)*DM4 + & +( GIPX*RIPPZ- GIPZ*RIPPX)*DM5)*TFPHI2 + TDZ(2)=TDZ(2)+ + & ((RIPPY*RIP3X-RIPPX*RIP3Y)*DM4 + & +( GIPY*RIPPX- GIPX*RIPPY)*DM5)*TFPHI2 +C THIRD ATOM BY PHI1 + TDX(3)=(-GIX+RIPPY*RIZ-RIPPZ*RIY)*DM1 + & -(GIY*RIZ-RIY*GIZ)*DM2+RIPPX*DM3 + TDY(3)=(-GIY+RIPPZ*RIX-RIPPX*RIZ)*DM1 + & -(GIZ*RIX-RIZ*GIX)*DM2+RIPPY*DM3 + TDZ(3)=(-GIZ+RIPPX*RIY-RIPPY*RIX)*DM1 + & -(GIX*RIY-RIX*GIY)*DM2+RIPPZ*DM3 + TDX(3)=TDX(3)*TFPHI1 + TDY(3)=TDY(3)*TFPHI1 + TDZ(3)=TDZ(3)*TFPHI1 +C THIRD ATOM BY PHI2 + TDX(3)=TDX(3)+ + & ((CIPPY*RIP3Z-CIPPZ*RIP3Y)*DM4 + & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5)*TFPHI2 + TDY(3)=TDY(3)+ + & ((CIPPZ*RIP3X-CIPPX*RIP3Z)*DM4 + & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5)*TFPHI2 + TDZ(3)=TDZ(3)+ + & ((CIPPX*RIP3Y-CIPPY*RIP3X)*DM4 + & -(CIPPX*GIPY-CIPPY*GIPX)*DM5)*TFPHI2 +C FOURTH ATOM BY PHI1 + TDX(4)=(GIX*DM1-RIPPX*DM3)*TFPHI1 + TDY(4)=(GIY*DM1-RIPPY*DM3)*TFPHI1 + TDZ(4)=(GIZ*DM1-RIPPZ*DM3)*TFPHI1 +C FOURTH ATOM BY PHI2 + TDX(4)=TDX(4)+ + & ((-GIPX+RIP3Y*RIPZ-RIP3Z*RIPY)*DM4 + & -( GIPY*RIPZ-RIPY*GIPZ)*DM5 + & + RIP3X*DM6)*TFPHI2 + TDY(4)=TDY(4)+ + & ((-GIPY+RIP3Z*RIPX-RIP3X*RIPZ)*DM4 + & -( GIPZ*RIPX-RIPZ*GIPX)*DM5 + & + RIP3Y*DM6)*TFPHI2 + TDZ(4)=TDZ(4)+ + & ((-GIPZ+RIP3X*RIPY-RIP3Y*RIPX)*DM4 + & -( GIPX*RIPY-RIPX*GIPY)*DM5 + & + RIP3Z*DM6)*TFPHI2 +C FIFTH ATOM BY PHI2 + TDX(5)=(GIPX*DM4-RIP3X*DM6)*TFPHI2 + TDY(5)=(GIPY*DM4-RIP3Y*DM6)*TFPHI2 + TDZ(5)=(GIPZ*DM4-RIP3Z*DM6)*TFPHI2 +C END OF FORCE DIRECTION +c force calcuation + DO II=1,5 + gdfat(1,IATOM(II))=gdfat(1,IATOM(II))+TDX(II) + gdfat(2,IATOM(II))=gdfat(2,IATOM(II))+TDY(II) + gdfat(3,IATOM(II))=gdfat(3,IATOM(II))+TDZ(II) + ENDDO +c energy calculation + enephi = enephi + ephi +c end of single assignment statement + ENDDO +C END OF PHI RESTRAINT + +C START OF THETA ANGLE + do i=1, idfathe + + athe = 0.0d0 + do iii=1,5 + iatom(iii)=ithelis(iii,i)+ishiftca + enddo + + +C ANGLE VECTOR CALCULTION + RIX=C(1,IATOM(2))-C(1,IATOM(1)) + RIY=C(2,IATOM(2))-C(2,IATOM(1)) + RIZ=C(3,IATOM(2))-C(3,IATOM(1)) + + RIPX=C(1,IATOM(3))-C(1,IATOM(2)) + RIPY=C(2,IATOM(3))-C(2,IATOM(2)) + RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) + + RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) + RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) + RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) + + RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) + RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) + RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) + + GIX=RIY*RIPZ-RIZ*RIPY + GIY=RIZ*RIPX-RIX*RIPZ + GIZ=RIX*RIPY-RIY*RIPX + + GIPX=RIPY*RIPPZ-RIPZ*RIPPY + GIPY=RIPZ*RIPPX-RIPX*RIPPZ + GIPZ=RIPX*RIPPY-RIPY*RIPPX + + GIPPX=RIPPY*RIP3Z-RIPPZ*RIP3Y + GIPPY=RIPPZ*RIP3X-RIPPX*RIP3Z + GIPPZ=RIPPX*RIP3Y-RIPPY*RIP3X + + CIPX=C(1,IATOM(3))-C(1,IATOM(1)) + CIPY=C(2,IATOM(3))-C(2,IATOM(1)) + CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) + + CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) + CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) + CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) + + CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) + CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) + CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) + + DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) + DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) + DGIPP=SQRT(GIPPX*GIPPX+GIPPY*GIPPY+GIPPZ*GIPPZ) + DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) + DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) +C END OF ANGLE VECTOR CALCULTION + + TDOT=GIX*GIPX+GIY*GIPY+GIZ*GIPZ + ATHE(1)=TDOT/(DGI*DGIP) + TDOT=GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ + ATHE(2)=TDOT/(DGIP*DGIPP) + + ETHE=0.0D0 + TFTHE1=0.0D0 + TFTHE2=0.0D0 + SCC=0.0D0 + TH_TMP=0.0d0 + + do j=1,ithenum(i) + ddth1=athe(1)-fthe1(i,j) !cos(the1)-cos(the1_ref) + ddth2=athe(2)-fthe2(i,j) !cos(the2)-cos(the2_ref) + dtmp= (ddth1**2+ddth2**2)/cwidth2 + if ( dtmp .ge. 15.0d0) then + th_tmp = 0.0d0 + else +c th_tmp = dfaexp ( idint(dtmp*1000)+1 ) + th_tmp = exp(-dtmp) + end if + + ethe=ethe+sccthe(i,j)*th_tmp + + tfthe1=tfthe1+sccthe(i,j)*ddth1/cwidth*th_tmp !-dv/dcos(the1) + tfthe2=tfthe2+sccthe(i,j)*ddth2/cwidth*th_tmp !-dv/dcos(the2) + scc=scc+sccthe(i,j) +C write(*,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), +C & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) + enddo + + ethe=-ethe/scc*the_inc*wwangle + tfthe1=tfthe1/scc*the_inc*wwangle + tfthe2=tfthe2/scc*the_inc*wwangle + + IF (ABS(ETHE).LT.TENM20) THEN + ETHE=0.0D0 + ENDIF + IF (ABS(TFTHE1).LT.TENM20) THEN + TFTHE1=0.0D0 + ENDIF + IF (ABS(TFTHE2).LT.TENM20) THEN + TFTHE2=0.0D0 + ENDIF + + TDX(1:5)=0.0D0 + TDY(1:5)=0.0D0 + TDZ(1:5)=0.0D0 + + DM1=1.0d0/(DGI*DGIP) + DM2=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI**3*DGIP) + DM3=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI*DGIP**3) + + DM4=1.0d0/(DGIP*DGIPP) + DM5=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP**3*DGIPP) + DM6=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP*DGIPP**3) + +C FIRST ATOM BY THETA1 + TDX(1)=((RIPZ*GIPY-RIPY*GIPZ)*DM1 + & -(GIY*RIPZ-GIZ*RIPY)*DM2)*TFTHE1 + TDY(1)=((-RIPZ*GIPX+RIPX*GIPZ)*DM1 + & -(-GIX*RIPZ+GIZ*RIPX)*DM2)*TFTHE1 + TDZ(1)=((RIPY*GIPX-RIPX*GIPY)*DM1 + & -(GIX*RIPY-GIY*RIPX)*DM2)*TFTHE1 +C SECOND ATOM BY THETA1 + TDX(2)=((CIPY*GIPZ-CIPZ*GIPY-RIPPY*GIZ+RIPPZ*GIY)*DM1 + & -(CIPY*GIZ-CIPZ*GIY)*DM2 + & +(RIPPY*GIPZ-RIPPZ*GIPY)*DM3)*TFTHE1 + TDY(2)=((CIPZ*GIPX-CIPX*GIPZ-RIPPZ*GIX+RIPPX*GIZ)*DM1 + & -(CIPZ*GIX-CIPX*GIZ)*DM2 + & +(RIPPZ*GIPX-RIPPX*GIPZ)*DM3)*TFTHE1 + TDZ(2)=((CIPX*GIPY-CIPY*GIPX-RIPPX*GIY+RIPPY*GIX)*DM1 + & -(CIPX*GIY-CIPY*GIX)*DM2 + & +(RIPPX*GIPY-RIPPY*GIPX)*DM3)*TFTHE1 +C SECOND ATOM BY THETA2 + TDX(2)=TDX(2)+ + & ((RIPPZ*GIPPY-RIPPY*GIPPZ)*DM4 + & -(GIPY*RIPPZ-GIPZ*RIPPY)*DM5)*TFTHE2 + TDY(2)=TDY(2)+ + & ((-RIPPZ*GIPPX+RIPPX*GIPPZ)*DM4 + & -(-GIPX*RIPPZ+GIPZ*RIPPX)*DM5)*TFTHE2 + TDZ(2)=TDZ(2)+ + & ((RIPPY*GIPPX-RIPPX*GIPPY)*DM4 + & -(GIPX*RIPPY-GIPY*RIPPX)*DM5)*TFTHE2 +C THIRD ATOM BY THETA1 + TDX(3)=((GIPY*RIZ-GIPZ*RIY-GIY*CIPPZ+GIZ*CIPPY)*DM1 + & -(GIY*RIZ-GIZ*RIY)*DM2 + & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM3) *TFTHE1 + TDY(3)=((GIPZ*RIX-GIPX*RIZ-GIZ*CIPPX+GIX*CIPPZ)*DM1 + & -(GIZ*RIX-GIX*RIZ)*DM2 + & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM3) *TFTHE1 + TDZ(3)=((GIPX*RIY-GIPY*RIX-GIX*CIPPY+GIY*CIPPX)*DM1 + & -(GIX*RIY-GIY*RIX)*DM2 + & -(CIPPX*GIPY-CIPPY*GIPX)*DM3) *TFTHE1 +C THIRD ATOM BY THETA2 + TDX(3)=TDX(3)+ + & ((CIPPY*GIPPZ-CIPPZ*GIPPY-RIP3Y*GIPZ+RIP3Z*GIPY)*DM4 + & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5 + & +(RIP3Y*GIPpZ-RIP3Z*GIPpY)*DM6) *TFTHE2 + TDY(3)=TDY(3)+ + & ((CIPPZ*GIPPX-CIPPX*GIPPZ-RIP3Z*GIPX+RIP3X*GIPZ)*DM4 + & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5 + & +(RIP3Z*GIPpX-RIP3X*GIPpZ)*DM6) *TFTHE2 + TDZ(3)=TDZ(3)+ + & ((CIPPX*GIPPY-CIPPY*GIPPX-RIP3X*GIPY+RIP3Y*GIPX)*DM4 + & -(CIPPX*GIPY-CIPPY*GIPX)*DM5 + & +(RIP3X*GIPpY-RIP3Y*GIPpX)*DM6) *TFTHE2 +C FOURTH ATOM BY THETA1 + TDX(4)=-((GIZ*RIPY-GIY*RIPZ)*DM1 + & -(GIPZ*RIPY-GIPY*RIPZ)*DM3) *TFTHE1 + TDY(4)=-((GIX*RIPZ-GIZ*RIPX)*DM1 + & -(GIPX*RIPZ-GIPZ*RIPX)*DM3) *TFTHE1 + TDZ(4)=-((GIY*RIPX-GIX*RIPY)*DM1 + & -(GIPY*RIPX-GIPX*RIPY)*DM3) *TFTHE1 +C FOURTH ATOM BY THETA2 + TDX(4)=TDX(4)+ + & ((GIPPY*RIPZ-GIPPZ*RIPY-GIPY*CIP3Z+GIPZ*CIP3Y)*DM4 + & -(GIPY*RIPZ-GIPZ*RIPY)*DM5 + & -(CIP3Y*GIPPZ-CIP3Z*GIPPY)*DM6)*TFTHE2 + TDY(4)=TDY(4)+ + & ((GIPPZ*RIPX-GIPPX*RIPZ-GIPZ*CIP3X+GIPX*CIP3Z)*DM4 + & -(GIPZ*RIPX-GIPX*RIPZ)*DM5 + & -(CIP3Z*GIPPX-CIP3X*GIPPZ)*DM6)*TFTHE2 + TDZ(4)=TDZ(4)+ + & ((GIPPX*RIPY-GIPPY*RIPX-GIPX*CIP3Y+GIPY*CIP3X)*DM4 + & -(GIPX*RIPY-GIPY*RIPX)*DM5 + & -(CIP3X*GIPPY-CIP3Y*GIPPX)*DM6)*TFTHE2 +C FIFTH ATOM BY THETA2 + TDX(5)=-((GIPZ*RIPPY-GIPY*RIPPZ)*DM4 + & -(GIPPZ*RIPPY-GIPPY*RIPPZ)*DM6)*TFTHE2 + TDY(5)=-((GIPX*RIPPZ-GIPZ*RIPPX)*DM4 + & -(GIPPX*RIPPZ-GIPPZ*RIPPX)*DM6)*TFTHE2 + TDZ(5)=-((GIPY*RIPPX-GIPX*RIPPY)*DM4 + & -(GIPPY*RIPPX-GIPPX*RIPPY)*DM6)*TFTHE2 +C !! END OF FORCE DIRECTION!!!! + DO II=1,5 + gdfat(1,iatom(II))=gdfat(1,iatom(II))+TDX(II) + gdfat(2,iatom(II))=gdfat(2,iatom(II))+TDY(II) + gdfat(3,iatom(II))=gdfat(3,iatom(II))+TDZ(II) + ENDDO +C energy calculation + enethe = enethe + ethe + ENDDO + + edfator = enephi + enethe + + RETURN + END + + subroutine edfan(edfanei) +C DFA neighboring CA restraint + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + integer i,j,imin + integer kshnum, n1atom + + double precision enenei,tmp_n + double precision pai,hpai + double precision jix,jiy,jiz,ndiff,snorm_nei + double precision t2dx(maxres),t2dy(maxres),t2dz(maxres) + double precision dr,dr2,half,ntmp,dtmp + + parameter(dr=0.25d0,dr2=0.50d0,half=0.50d0) + parameter(pai=3.14159265358979323846D0) + parameter(hpai=1.5707963267948966D0) + parameter(snorm_nei=0.886226925452758D0) + + edfanei = 0.0d0 + enenei = 0.0d0 + gdfan = 0.0d0 + +c print*, 's1:', s1(:) +c print*, 's2:', s2(:) + + do i=1, idfanei + + kshnum=kshell(i) + n1atom=ineilis(i)+ishiftca +C write(*,*) 'kshnum,n1atom:', kshnum, n1atom + + tmp_n=0.0d0 + ftmp=0.0d0 + dnei=0.0d0 + dist=0.0d0 + t1dx=0.0d0 + t1dy=0.0d0 + t1dz=0.0d0 + t2dx=0.0d0 + t2dy=0.0d0 + t2dz=0.0d0 + + do j = ishiftca+1, ilastca + + if (n1atom.eq.j) cycle + + jix=c(1,j)-c(1,n1atom) + jiy=c(2,j)-c(2,n1atom) + jiz=c(3,j)-c(3,n1atom) + dist=sqrt(jix*jix+jiy*jiy+jiz*jiz) + +c write(*,*) n1atom, j, dist + + if(kshnum.ne.1)then + if (dist.lt.s1(kshnum).and. + & dist.gt.s2(kshnum-1)) then + + tmp_n=tmp_n+1.0d0 + +c write(*,*) 'case1:',tmp_n + + t1dx=t1dx+0.0d0 + t1dy=t1dy+0.0d0 + t1dz=t1dz+0.0d0 + t2dx(j)=0.0d0 + t2dy(j)=0.0d0 + t2dz(j)=0.0d0 + + elseif(dist.ge.s1(kshnum).and. + & dist.le.s2(kshnum)) then + + dnei=(dist-s1(kshnum))/dr2*pai + tmp_n=tmp_n + half*(1+cos(dnei)) +c write(*,*) 'case2:',tmp_n + ftmp=-pai*sin(dnei)/dr2/dist/2.0d0 +c center atom + t1dx=t1dx+jix*ftmp + t1dy=t1dy+jiy*ftmp + t1dz=t1dz+jiz*ftmp +c neighbor atoms + t2dx(j)=-jix*ftmp + t2dy(j)=-jiy*ftmp + t2dz(j)=-jiz*ftmp +c + elseif(dist.ge.s1(kshnum-1).and. + & dist.le.s2(kshnum-1)) then + dnei=(dist-s1(kshnum-1))/dr2*pai + tmp_n=tmp_n + 1.0d0 - half*(1+cos(dnei)) +c write(*,*) 'case3:',tmp_n + ftmp = hpai*sin(dnei)/dr2/dist +c center atom + t1dx=t1dx+jix*ftmp + t1dy=t1dy+jiy*ftmp + t1dz=t1dz+jiz*ftmp +c neighbor atoms + t2dx(j)=-jix*ftmp + t2dy(j)=-jiy*ftmp + t2dz(j)=-jiz*ftmp + + endif + + elseif(kshnum.eq.1) then + + if(dist.lt.s1(kshnum))then + + tmp_n=tmp_n+1.0d0 +c write(*,*) 'case4:',tmp_n + t1dx=t1dx+0.0d0 + t1dy=t1dy+0.0d0 + t1dz=t1dz+0.0d0 + t2dx(j)=0.0d0 + t2dy(j)=0.0d0 + t2dz(j)=0.0d0 + + elseif(dist.ge.s1(kshnum).and. + & dist.le.s2(kshnum))then + + dnei=(dist-s1(kshnum))/dr2*pai + tmp_n=tmp_n + half*(1+cos(dnei)) +c write(*,*) 'case5:',tmp_n + ftmp = -hpai*sin(dnei)/dr2/dist +c center atom + t1dx=t1dx+jix*ftmp + t1dy=t1dy+jiy*ftmp + t1dz=t1dz+jiz*ftmp +c neighbor atoms + t2dx(j)=-jix*ftmp + t2dy(j)=-jiy*ftmp + t2dz(j)=-jiz*ftmp + + endif + endif + enddo + + scc=0.0d0 + enei=0.0d0 + tmp_fnei=0.0d0 + ndiff=0.0d0 + + do imin=1,ineinum(i) + + ndiff = tmp_n-fnei(i,imin) + dtmp = ndiff*ndiff + + if (dtmp.ge.15.0d0) then + ntmp = 0.0d0 + else +c ntmp = dfaexp( idint(dtmp*1000) + 1 ) + ntmp = exp(-dtmp) + end if + + enei=enei+sccnei(i,imin)*ntmp + tmp_fnei=tmp_fnei- + & sccnei(i,imin)*ntmp*ndiff*2.0d0 + scc=scc+sccnei(i,imin) + +c write(*,'(a,1x,2i8,f12.7,i8,3f12.7)')'NEI:',i,imin,tmp_n, +c & fnei(i,imin),sccnei(i,imin),enei,scc + enddo + + enei=-enei/scc*snorm_nei*nei_inc*wwnei + tmp_fnei=tmp_fnei/scc*snorm_nei*nei_inc*wwnei + +c if (abs(enei).lt.1.0d-20)then +c enei=0.0d0 +c endif +c if (abs(tmp_fnei).lt.1.0d-20) then +c tmp_fnei=0.0d0 +c endif + +c force calculation + t1dx=t1dx*tmp_fnei + t1dy=t1dy*tmp_fnei + t1dz=t1dz*tmp_fnei + + do j=ishiftca+1,ilastca + t2dx(j)=t2dx(j)*tmp_fnei + t2dy(j)=t2dy(j)*tmp_fnei + t2dz(j)=t2dz(j)*tmp_fnei + enddo + + gdfan(1,n1atom)=gdfan(1,n1atom)+t1dx + gdfan(2,n1atom)=gdfan(2,n1atom)+t1dy + gdfan(3,n1atom)=gdfan(3,n1atom)+t1dz + + do j=ishiftca+1,ilastca + gdfan(1,j)=gdfan(1,j)+t2dx(j) + gdfan(2,j)=gdfan(2,j)+t2dy(j) + gdfan(3,j)=gdfan(3,j)+t2dz(j) + enddo +c energy calculation + + enenei=enenei+enei + + enddo + + edfanei=enenei + + return + end + + subroutine edfab(edfabeta) + + implicit real*8 (a-h,o-z) + + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.DFA' + + real*8 PAI + parameter(PAI=3.14159265358979323846D0) + parameter (maxca=800) +C sheet variables + real*8 bx(maxres),by(maxres),bz(maxres) + real*8 vbet(maxres,maxres) + real*8 shetfx(maxres),shetfy(maxres),shetfz(maxres) + real*8 shefx(maxres,12),shefy(maxres,12),shefz(maxres,12) + real*8 vbeta,vbetp,vbetm + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + & c00,s00,ulnex,dnex + real*8 dp45,dm45,w_beta + + real*8 cph(maxca),cth(maxca) + real*8 atx(maxca),aty(maxca),atz(maxca) + real*8 atmx(maxca),atmy(maxca),atmz(maxca) + real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) + real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) + real*8 sth(maxca) + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + + real*8 atxnum(maxca),atynum(maxca),atznum(maxca), + & astxnum(maxca),astynum(maxca),astznum(maxca), + & atmxnum(maxca),atmynum(maxca),atmznum(maxca), + & astmxnum(maxca),astmynum(maxca),astmznum(maxca), + & atmmxnum(maxca),atmmynum(maxca),atmmznum(maxca), + & astmmxnum(maxca),astmmynum(maxca),astmmznum(maxca), + & atm3xnum(maxca),atm3ynum(maxca),atm3znum(maxca), + & astm3xnum(maxca),astm3ynum(maxca),astm3znum(maxca), + & cth_orig(maxca),sth_orig(maxca) + + common /sheca/ bx,by,bz + common /shee/ vbeta,vbet,vbetp,vbetm + common /shetf/ shetfx,shetfy,shetfz + common /shef/ shefx, shefy, shefz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + & c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + + common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, + $ atmmz,atm3x,atm3y,atm3z + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + $ astmmz,astm3x,astm3y,astm3z + + common /coscos/ cph,cth + common /sinsin/ sth + +C End of sheet variables + + integer i,j + double precision enebet + + enebet=0.0d0 + bx=0.0d0;by=0.0d0;bz=0.0d0 + shetfx=0.0d0;shetfy=0.0d0;shetfz=0.0d0 + + gdfab=0.0d0 + + do i=ishiftca+1,ilastca + bx(i-ishiftca)=c(1,i) + by(i-ishiftca)=c(2,i) + bz(i-ishiftca)=c(3,i) + enddo + +c do i=1,ilastca-ishiftca +c read(99,*) bx(i),by(i),bz(i) +c enddo +c close(99) + + dca=0.25d0**2 + dshe=0.3d0**2 + ULHB=5.0D0 + ULDHB=5.0D0 + ULNEX=COS(60.0D0/180.0D0*PAI) + + DLHB=1.0D0 + DLDHB=1.0D0 + + DNEX=0.3D0**2 + + C00=COS((1.0D0+10.0D0/180.0D0)*PAI) + S00=SIN((1.0D0+10.0D0/180.0D0)*PAI) + + W_BETA=0.5D0 + DP45=W_BETA + DM45=W_BETA + +C END OF INITIALIZATION + + nca=ilastca-ishiftca + + call angvectors(nca) + call sheetforce(nca,wshet) + +c end of sheet energy and force + + do j=1,nca + shetfx(j)=shetfx(j)*beta_inc + shetfy(j)=shetfy(j)*beta_inc + shetfz(j)=shetfz(j)*beta_inc +c write(*,*)'SHETF:',shetfx(j),shetfy(j),shetfz(j) + enddo + + vbeta=vbeta*beta_inc + enebet=vbeta + edfabeta=enebet + + do j=1,nca + gdfab(1,j+ishiftca)=gdfab(1,j+ishiftca)-shetfx(j) + gdfab(2,j+ishiftca)=gdfab(2,j+ishiftca)-shetfy(j) + gdfab(3,j+ishiftca)=gdfab(3,j+ishiftca)-shetfz(j) + enddo + +#ifdef DEBUG1 + do j=1,nca + write(*,'(5x,i5,10x,3f10.5)') j,bx(j),by(j),bz(j) + enddo + + + gdfab=0 + dinc=0.001 + do j=1,nca + cth_orig(j)=cth(j) + sth_orig(j)=sth(j) + enddo + + do j=1,nca + + bx(j)=bx(j)+dinc + call angvectors(nca) + bx(j)=bx(j)-2*dinc + call angvectors(nca) + atxnum(j)=0.5*(cth(j)-cth_orig(j))/dinc + astxnum(j)=0.5*(sth(j)-sth_orig(j))/dinc + if (j.gt.1) then + atmxnum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc + astmxnum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc + endif + if (j.gt.2) then + atmmxnum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc + astmmxnum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc + endif + if (j.gt.3) then + atm3xnum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc + astm3xnum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc + endif + bx(j)=bx(j)+dinc + by(j)=by(j)+dinc + call angvectors(nca) + by(j)=by(j)-2*dinc + call angvectors(nca) + by(j)=by(j)+dinc + atynum(j)=0.5*(cth(j)-cth_orig(j))/dinc + astynum(j)=0.5*(sth(j)-sth_orig(j))/dinc + if (j.gt.1) then + atmynum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc + astmynum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc + endif + if (j.gt.2) then + atmmynum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc + astmmynum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc + endif + if (j.gt.3) then + atm3ynum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc + astm3ynum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc + endif + + bz(j)=bz(j)+dinc + call angvectors(nca) + bz(j)=bz(j)-2*dinc + call angvectors(nca) + bz(j)=bz(j)+dinc + + atznum(j)=0.5*(cth(j)-cth_orig(j))/dinc + astznum(j)=0.5*(sth(j)-sth_orig(j))/dinc + if (j.gt.1) then + atmznum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc + astmznum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc + endif + if (j.gt.2) then + atmmznum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc + astmmznum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc + endif + if (j.gt.3) then + atm3znum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc + astm3znum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc + endif + + enddo + + do i=1,nca + write (*,'(2i5,a2,6f10.5)') + & i,1,"x",atxnum(i),atx(i),atxnum(i)/atx(i), + & astxnum(i),astx(i),astxnum(i)/astx(i), + & i,1,"y",atynum(i),aty(i),atynum(i)/aty(i), + & astynum(i),asty(i),astynum(i)/asty(i), + & i,1,"z",atznum(i),atz(i),atznum(i)/atz(i), + & astznum(i),astz(i),astznum(i)/astz(i), + & i,2,"x",atmxnum(i),atmx(i),atmxnum(i)/atmx(i), + & astmxnum(i),astmx(i),astmxnum(i)/astmx(i), + & i,2,"y",atmynum(i),atmy(i),atmynum(i)/atmy(i), + & astmynum(i),astmy(i),astmynum(i)/astmy(i), + & i,2,"z",atmznum(i),atmz(i),atmznum(i)/atmz(i), + & astmznum(i),astmz(i),astmznum(i)/astmz(i), + & i,3,"x",atmmxnum(i),atmmx(i),atmmxnum(i)/atmmx(i), + & astmmxnum(i),astmmx(i),astmmxnum(i)/astmmx(i), + & i,3,"y",atmmynum(i),atmmy(i),atmmynum(i)/atmmy(i), + & astmmynum(i),astmmy(i),astmmynum(i)/astmmy(i), + & i,3,"z",atmmznum(i),atmmz(i),atmmznum(i)/atmmz(i), + & astmmznum(i),astmmz(i),astmmznum(i)/astmmz(i), + & i,4,"x",atm3xnum(i),atm3x(i),atm3xnum(i)/atm3x(i), + & astm3xnum(i),astm3x(i),astm3xnum(i)/astm3x(i), + & i,4,"y",atm3ynum(i),atm3y(i),atm3ynum(i)/atm3y(i), + & astm3ynum(i),astm3y(i),astm3ynum(i)/astm3y(i), + & i,4,"z",atm3znum(i),atm3z(i),atm3znum(i)/atm3z(i), + & astm3znum(i),astm3z(i),astm3znum(i)/astm3z(i), + & i,0," ",cth_orig(i),sth_orig(i) + enddo + + + gdfab=0 + dinc=0.001 + + do j=1,nca + + bx(j)=bx(j)+dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta1=vbeta*beta_inc + bx(j)=bx(j)-2*dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta2=vbeta*beta_inc + gdfab(1,j)=(vbeta2-vbeta1)/dinc/2 + bx(j)=bx(j)+dinc + + by(j)=by(j)+dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta1=vbeta*beta_inc + by(j)=by(j)-2*dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta2=vbeta*beta_inc + gdfab(2,j)=(vbeta2-vbeta1)/dinc/2 + by(j)=by(j)+dinc + + bz(j)=bz(j)+dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta1=vbeta*beta_inc + bz(j)=bz(j)-2*dinc + call angvectors(nca) + call sheetforce(nca,wshet) + vbeta2=vbeta*beta_inc + gdfab(3,j)=(vbeta2-vbeta1)/dinc/2 + bz(j)=bz(j)+dinc + + + enddo + + + call angvectors(nca) + call sheetforce(nca,wshet) + do j=1,nca + shetfx(j)=shetfx(j)*beta_inc + shetfy(j)=shetfy(j)*beta_inc + shetfz(j)=shetfz(j)*beta_inc + enddo + + + write(*,*) 'xyz analytical and numerical gradient' + do j=1,nca + write(*,'(5x,i5,10x,6f10.5)') j,-shetfx(j),-shetfy(j),-shetfz(j) + & ,(-gdfab(i,j),i=1,3) + enddo + + do j=1,nca + write(*,'(5x,i5,10x,3f10.2)') j,shetfx(j)/gdfab(1,j), + & shetfy(j)/gdfab(2,j), + & shetfz(j)/gdfab(3,j) + enddo + + stop +#endif + + return + end +C------------------------------------------------------------------------------- + subroutine angvectors(nca) +c implicit real*4(a-h,o-z) + implicit none + integer nca + integer maxca + parameter(maxca=800) + real*8 pai,zero + parameter(PAI=3.14159265358979323846D0,zero=0.0d0) + + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 apx(maxca),apy(maxca),apz(maxca) + real*8 apmx(maxca),apmy(maxca),apmz(maxca) + real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) + real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) + real*8 atx(maxca),aty(maxca),atz(maxca) + real*8 atmx(maxca),atmy(maxca),atmz(maxca) + real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) + real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + real*8 sth(maxca) + real*8 cph(maxca),cth(maxca) + real*8 ulcos(maxca) + real*8 p,c + integer i, ip, ipp, ip3, j + real*8 rx(maxca, maxca), ry(maxca, maxca), rz(maxca, maxca) + real*8 rix, riy, riz, ripx, ripy, ripz, rippx, rippy, rippz + real*8 gix, giy, giz, gipx, gipy, gipz, gippx, gippy, gippz + real*8 cix, ciy, ciz, cipx, cipy, cipz + real*8 gpcrp_x, gpcrp_y, gpcrp_z, d_gpcrp, gpcrp__g + real*8 d10, d11, d12, d13, d20, d21, d22, d23, d24 + real*8 d30, d31, d32, d33, d34, d35, d40, d41, d42, d43 + real*8 d_gcr, d_gcr3, d_gmcrim,d_gmcrim3,dgmmcrimm,d_gmmcrimm3 + real*8 dg, dg3, dg30, dgm, dgm3, dgmm, dgmm3, dgp, dri + real*8 dri3, drim, drim3, drimm, drip, dripp, g3gmm, g3rim + real*8 g3x, g3y, g3z, d_gmmcrimm, g3rim_,gcr__gm + real*8 gcr_x,gcr_y,gcr_z,ggm,ggp,gmcrim__gmm + real*8 gmcrim_x,gmcrim_y,gmcrim_z,gmmcrimm__gmmm + real*8 gmmcrimm_x,gmmcrimm_y,gmmcrimm_z,gmmgm,gmmr + real*8 gmmx,gmmy,gmmz,gmrp,gmx,gmy,gmz,gpx,gpy,gpz + real*8 grpp,gx,gy,gz + real*8 rim3x,rim3y,rim3z,rimmx,rimmy,rimmz,rimx,rimy,rimz + real*8 sd10,sd11,sd20,sd21,sd22,sd30,sd31,sd32,sd40,sd41 + integer inb,nmax,iselect + + common /sheca/ bx,by,bz + common /difvec/ rx, ry, rz + common /ulang/ ulcos + common /phys1/ inb,nmax,iselect + common /phys4/ p,c + common /kyori2/ dis + common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, + & apmmz,apm3x,apm3y,apm3z + common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, + & atmmz,atm3x,atm3y,atm3z + common /coscos/ cph,cth + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + & astmmz,astm3x,astm3y,astm3z + common /sinsin/ sth +C------------------------------------------------------------------------------- +c write(*,*) 'inside angvectors' +C initialize + p=0.1d0 + c=1.0d0 + inb=nca + cph=zero; cth=zero; sth=zero + apx=zero;apy=zero;apz=zero;apmx=zero;apmy=zero;apmz=zero + apmmx=zero;apmmy=zero;apmmz=zero;apm3x=zero;apm3y=zero;apm3z=zero + atx=zero;aty=zero;atz=zero;atmx=zero;atmy=zero;atmz=zero + atmmx=zero;atmmy=zero;atmmz=zero;atm3x=zero;atm3y=zero;atm3z=zero + astx=zero;asty=zero;astz=zero;astmx=zero;astmy=zero;astmz=zero + astmmx=zero;astmmy=zero;astmmz=zero;astm3x=zero;astm3y=zero + astm3z=zero +C end of initialize +C r[x,y,z] calc and distance calculation + rx=zero;ry=zero;rz=zero + + do i=1,inb + do j=1,inb + rx(i,j)=bx(j)-bx(i) + ry(i,j)=by(j)-by(i) + rz(i,j)=bz(j)-bz(i) + dis(i,j)=sqrt(rx(i,j)**2+ry(i,j)**2+rz(i,j)**2) +c write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) +c write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) +c write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) +c write(*,*) 'dis(i,j):',i,j,dis(i,j) + enddo + enddo +c end of r[x,y,z] calc +C cos calc + do i=1,inb-2 + ip=i+1 + ipp=i+2 + + if(dis(i,ip).ge.1.0e-8.and.dis(ip,ipp).ge.1.0e-8) then + ulcos(i)=rx(i,ip)*rx(ip,ipp)+ry(i,ip)*ry(ip,ipp) + $ +rz(i,ip)*rz(ip,ipp) + ulcos(i)=ulcos(i)/(dis(i,ip)*dis(ip,ipp)) + endif + enddo +c end of virtual bond angle +c write(*,*) 'inside angvectors1' +crc do i=1,inb-3 + do i=1,inb + ip=i+1 + ipp=i+2 + ip3=i+3 + rix=bx(ip)-bx(i) + riy=by(ip)-by(i) + riz=bz(ip)-bz(i) + ripx=bx(ipp)-bx(ip) + ripy=by(ipp)-by(ip) + ripz=bz(ipp)-bz(ip) + rippx=bx(ip3)-bx(ipp) + rippy=by(ip3)-by(ipp) + rippz=bz(ip3)-bz(ipp) + + gx=riy*ripz-riz*ripy + gy=riz*ripx-rix*ripz + gz=rix*ripy-riy*ripx + gpx=ripy*rippz-ripz*rippy + gpy=ripz*rippx-ripx*rippz + gpz=ripx*rippy-ripy*rippx + gpcrp_x=gpy*ripz-gpz*ripy + gpcrp_y=gpz*ripx-gpx*ripz + gpcrp_z=gpx*ripy-gpy*ripx + d_gpcrp=sqrt(gpcrp_x**2+gpcrp_y**2+gpcrp_z**2) + gpcrp__g=gx*gpy*ripz+gpx*ripy*gz+ripx*gpz*gy + & -gz*gpy*ripx-gpz*ripy*gx-ripz*gpx*gy + + if(i.ge.2) then + rimx=bx(i)-bx(i-1) + rimy=by(i)-by(i-1) + rimz=bz(i)-bz(i-1) + gmx=rimy*riz-rimz*riy + gmy=rimz*rix-rimx*riz + gmz=rimx*riy-rimy*rix + dgm=sqrt(gmx**2+gmy**2+gmz**2) + dgm3=dgm**3 + ggm=gmx*gx+gmy*gy+gmz*gz + gmrp=gmx*ripx+gmy*ripy+gmz*ripz + drim=dis(i-1,i) + drim3=drim**3 + gcr_x=gy*riz-gz*riy + gcr_y=gz*rix-gx*riz + gcr_z=gx*riy-gy*rix + d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) + d_gcr3=d_gcr**3 + gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy + & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy + endif +c write(*,*) 'inside angvectors2' + if(i.ge.3) then + rimmx=bx(i-1)-bx(i-2) + rimmy=by(i-1)-by(i-2) + rimmz=bz(i-1)-bz(i-2) + drimm=dis(i-2,i-1) + gmmx=rimmy*rimz-rimmz*rimy + gmmy=rimmz*rimx-rimmx*rimz + gmmz=rimmx*rimy-rimmy*rimx + dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) + dgmm3=dgmm**3 + gmmgm=gmmx*gmx+gmmy*gmy+gmmz*gmz + gmmr=gmmx*rix+gmmy*riy+gmmz*riz + gmcrim_x=gmy*rimz-gmz*rimy + gmcrim_y=gmz*rimx-gmx*rimz + gmcrim_z=gmx*rimy-gmy*rimx + d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) + d_gmcrim3=d_gmcrim**3 + gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy + & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy + endif + + if(i.ge.4) then + rim3x=bx(i-2)-bx(i-3) + rim3y=by(i-2)-by(i-3) + rim3z=bz(i-2)-bz(i-3) + g3x=rim3y*rimmz-rim3z*rimmy + g3y=rim3z*rimmx-rim3x*rimmz + g3z=rim3x*rimmy-rim3y*rimmx + dg30=sqrt(g3x**2+g3y**2+g3z**2) + g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz + g3rim_=g3x*rimx+g3y*rimy+g3z*rimz +cc********************************************************************** + gmmcrimm_x=gmmy*rimmz-gmmz*rimmy + gmmcrimm_y=gmmz*rimmx-gmmx*rimmz + gmmcrimm_z=gmmx*rimmy-gmmy*rimmx + d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) + d_gmmcrimm3=d_gmmcrimm**3 + gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y + & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y + endif + + dri=dis(i,i+1) + drip=dis(i+1,i+2) + dripp=dis(i+2,i+3) + dri3=dri**3 + dg=sqrt(gx**2+gy**2+gz**2) + dgp=sqrt(gpx**2+gpy**2+gpz**2) + dg3=dg**3 + + ggp=gx*gpx+gy*gpy+gz*gpz + grpp=gx*rippx+gy*rippy+gz*rippz + + if(dg.gt.0.0D0.and.dripp.gt.0.0D0.and.dgp.gt.0.0D0 + & .and.d_gpcrp.gt.0.0D0) then + cph(i)=grpp/dg/dripp + cth(i)=ggp/dg/dgp + sth(i)=gpcrp__g/d_gpcrp/dg + else +c + cph(i)=1.0D0 + cth(i)=1.0D0 + sth(i)=0.0D0 + endif + +c write(*,*) 'inside angvectors3' + + if(dgp.gt.0.0D0.and.dg3.gt.0.0D0 + & .and.dripp.gt.0.0D0.and.d_gpcrp.gt.0.0D0) then + d10=1.0D0/(dg*dgp) + d11=ggp/(dg3*dgp) + d12=1.0D0/(dg*dripp) + d13=grpp/(dg3*dripp) + sd10=1.0D0/(d_gpcrp*dg) + sd11=gpcrp__g/(d_gpcrp*dg3) + else + d10=0.0D0 + d11=0.0D0 + d12=0.0D0 + d13=0.0D0 + sd10=0.0D0 + sd11=0.0D0 + endif + + atx(i)=(ripz*gpy-ripy*gpz)*d10 + & -(gy*ripz-gz*ripy)*d11 + aty(i)=(ripx*gpz-ripz*gpx)*d10 + & -(gz*ripx-gx*ripz)*d11 + atz(i)=(ripy*gpx-ripx*gpy)*d10 + & -(gx*ripy-gy*ripx)*d11 + astx(i)=sd10*(-gpx*ripy**2+ripx*gpz*ripz + & +ripy*gpy*ripx-gpx*ripz**2) + & -sd11*(gy*ripz-gz*ripy) + asty(i)=sd10*(-gpy*ripz**2+gpx*ripy*ripx + & -gpy*ripx**2+gpz*ripy*ripz) + & -sd11*(-gx*ripz+gz*ripx) + astz(i)=sd10*(ripy*gpy*ripz-gpz*ripx**2 + & -gpz*ripy**2+ripz*gpx*ripx) + & -sd11*(gx*ripy-gy*ripx) + apx(i)=(ripz*rippy-ripy*rippz)*d12 + & -(gy*ripz-gz*ripy)*d13 + apy(i)=(ripx*rippz-ripz*rippx)*d12 + & -(gz*ripx-gx*ripz)*d13 + apz(i)=(ripy*rippx-ripx*rippy)*d12 + & -(gx*ripy-gy*ripx)*d13 + + if(i.ge.2) then + cix=bx(ip)-bx(i-1) + ciy=by(ip)-by(i-1) + ciz=bz(ip)-bz(i-1) + cipx=bx(ipp)-bx(i) + cipy=by(ipp)-by(i) + cipz=bz(ipp)-bz(i) + ripx=bx(ipp)-bx(ip) + ripy=by(ipp)-by(ip) + ripz=bz(ipp)-bz(ip) + if(dgm3.gt.0.0D0.and.dg3.gt.0.0D0.and.drip.gt.0.0D0 + & .and.d_gcr3.gt.0.0D0) then + d20=1.0D0/(dg*dgm) + d21=ggm/(dgm3*dg) + d22=ggm/(dgm*dg3) + d23=1.0D0/(dgm*drip) + d24=gmrp/(dgm3*drip) + sd20=1.0D0/(d_gcr*dgm) + sd21=gcr__gm/(d_gcr3*dgm) + sd22=gcr__gm/(d_gcr*dgm3) + else + d20=0.0D0 + d21=0.0D0 + d22=0.0D0 + d23=0.0D0 + d24=0.0D0 + sd20=0.0D0 + sd21=0.0D0 + sd22=0.0D0 + endif + atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 + & -(ciy*gmz-ciz*gmy)*d21 + & +(ripy*gz-ripz*gy)*d22 + atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 + & -(ciz*gmx-cix*gmz)*d21 + & +(ripz*gx-ripx*gz)*d22 + atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 + & -(cix*gmy-ciy*gmx)*d21 + & +(ripx*gy-ripy*gx)*d22 +cc********************************************************************** + astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy + & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix + & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) + & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) + & +gcr_z*(-ripz*rix+gy)) + & -sd22*(-gmy*ciz+gmz*ciy) + + astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix + & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz + & +riz*ripz*gmy) + & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) + & -gcr_z*(ripz*riy+gx)) + & -sd22*(gmx*ciz-gmz*cix) + + astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz + & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy + & -riz*gx*cix) + & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) + & +gcr_z*(ripy*riy+ripx*rix)) + & -sd22*(-gmx*ciy+gmy*cix) +cc********************************************************************** + apmx(i)=(ciy*ripz-ripy*ciz)*d23 + & -(ciy*gmz-ciz*gmy)*d24 + apmy(i)=(ciz*ripx-ripz*cix)*d23 + & -(ciz*gmx-cix*gmz)*d24 + apmz(i)=(cix*ripy-ripx*ciy)*d23 + & -(cix*gmy-ciy*gmx)*d24 + endif + + if(i.ge.3) then + if(dgm3.gt.0.0D0.and.dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 + & .and.d_gmcrim3.gt.0.0D0) then + d30=1.0D0/(dgm*dgmm) + d31=gmmgm/(dgm3*dgmm) + d32=gmmgm/(dgm*dgmm3) + d33=1.0D0/(dgmm*dri) + d34=gmmr/(dgmm3*dri) + d35=gmmr/(dgmm*dri3) + sd30=1.0D0/(d_gmcrim*dgmm) + sd31=gmcrim__gmm/(d_gmcrim3*dgmm) + sd32=gmcrim__gmm/(d_gmcrim*dgmm3) + else + d30=0.0D0 + d31=0.0D0 + d32=0.0D0 + d33=0.0D0 + d34=0.0D0 + d35=0.0D0 + sd30=0.0D0 + sd31=0.0D0 + sd32=0.0D0 + endif + +c write(*,*) 'inside angvectors4' + +cc********************************************************************** + atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 + & -(ciy*gmz-ciz*gmy)*d31 + & -(gmmy*rimmz-gmmz*rimmy)*d32 + atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 + & -(ciz*gmx-cix*gmz)*d31 + & -(gmmz*rimmx-gmmx*rimmz)*d32 + atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 + & -(cix*gmy-ciy*gmx)*d31 + & -(gmmx*rimmy-gmmy*rimmx)*d32 +cc********************************************************************** + astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy + & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz + & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy + & -ciy*rimy*gmmx-rimz*gmx*rimmz) + & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) + & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) + & -sd32*(gmmy*rimmz-rimmy*gmmz) + + astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz + & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy + & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx + & +gmz*rimy*rimmz-rimz*ciz*gmmy) + & -sd31*(gmcrim_x*(cix*rimy-gmz) + & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) + & -sd32*(-gmmx*rimmz+rimmx*gmmz) + + astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz + & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx + & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy + & +rimz*ciy*gmmy+rimz*gmx*rimmx) + & -sd31*(gmcrim_x*(cix*rimz+gmy) + & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) + & -sd32*(gmmx*rimmy-rimmx*gmmy) +c********************************************************************** + apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 + & -(gmmy*rimmz-gmmz*rimmy)*d34 + & +rix*d35 + apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 + & -(gmmz*rimmx-gmmx*rimmz)*d34 + & +riy*d35 + apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 + & -(gmmx*rimmy-gmmy*rimmx)*d34 + & +riz*d35 + endif + + if(i.ge.4) then + if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 + & .and.drim3.gt.0.0D0 + & .and.d_gmmcrimm3.gt.0.0D0) then + d40=1.0D0/(dg30*dgmm) + d41=g3gmm/(dg30*dgmm3) + d42=1.0D0/(dg30*drim) + d43=g3rim_/(dg30*drim3) + sd40=1.0D0/(dg30*d_gmmcrimm) + sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) + else + d40=0.0D0 + d41=0.0D0 + d42=0.0D0 + d43=0.0D0 + sd40=0.0D0 + sd41=0.0D0 + endif + atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 + & -(gmmy*rimmz-gmmz*rimmy)*d41 + atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 + & -(gmmz*rimmx-gmmx*rimmz)*d41 + atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 + & -(gmmx*rimmy-gmmy*rimmx)*d41 +cc********************************************************************** + astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y + & -g3z*rimmz*rimmx+rimmy**2*g3x) + & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) + & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) + + astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y + & -rimmx*rimmy*g3x+rimmz**2*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmy + & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmy) + +c & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) + + astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z + & +g3z*rimmx**2-rimmz*rimmy*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz + & +gmmcrimm_z*(rimmy**2+rimmx**2)) +c********************************************************************** + apm3x(i)=g3x*d42-rimx*d43 + apm3y(i)=g3y*d42-rimy*d43 + apm3z(i)=g3z*d42-rimz*d43 + endif + enddo +c******************************************************************************* + +c write(*,*) 'inside angvectors5' + +c do i=inb-2,inb + do i=1,0 + rimx=bx(i)-bx(i-1) + rimy=by(i)-by(i-1) + rimz=bz(i)-bz(i-1) + rimmx=bx(i-1)-bx(i-2) + rimmy=by(i-1)-by(i-2) + rimmz=bz(i-1)-bz(i-2) + rim3x=bx(i-2)-bx(i-3) + rim3y=by(i-2)-by(i-3) + rim3z=bz(i-2)-bz(i-3) + gmmx=rimmy*rimz-rimmz*rimy + gmmy=rimmz*rimx-rimmx*rimz + gmmz=rimmx*rimy-rimmy*rimx + g3x=rim3y*rimmz-rim3z*rimmy + g3y=rim3z*rimmx-rim3x*rimmz + g3z=rim3x*rimmy-rim3y*rimmx + + dg30=sqrt(g3x**2+g3y**2+g3z**2) + g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz + dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) + dgmm3=dgmm**3 + drim=dis(i-1,i) + drimm=dis(i-2,i-1) + drim3=drim**3 + g3rim_=g3x*rimx+g3y*rimy+g3z*rimz +cc********************************************************************** + gmmcrimm_x=gmmy*rimmz-gmmz*rimmy + gmmcrimm_y=gmmz*rimmx-gmmx*rimmz + gmmcrimm_z=gmmx*rimmy-gmmy*rimmx + d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) + d_gmmcrimm3=d_gmmcrimm**3 + gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y + & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y + + if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 + & .and.drim3.gt.0.0D0 + & .and.d_gmmcrimm3.gt.0.0D0) then + d40=1.0D0/(dg30*dgmm) + d41=g3gmm/(dg30*dgmm3) + d42=1.0D0/(dg30*drim) + d43=g3rim_/(dg30*drim3) + sd40=1.0D0/(dg30*d_gmmcrimm) + sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) + else + d40=0.0D0 + d41=0.0D0 + d42=0.0D0 + d43=0.0D0 + sd40=0.0D0 + sd41=0.0D0 + endif + atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 + & -(gmmy*rimmz-gmmz*rimmy)*d41 + atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 + & -(gmmz*rimmx-gmmx*rimmz)*d41 + atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 + & -(gmmx*rimmy-gmmy*rimmx)*d41 +cc********************************************************************** + astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y + & -g3z*rimmz*rimmx+rimmy**2*g3x) + & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) + & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) + + astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y + & -rimmx*rimmy*g3x+rimmz**2*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmy + & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) + + astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z + & +g3z*rimmx**2-rimmz*rimmy*g3y) + & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz + & +gmmcrimm_z*(rimmy**2+rimmx**2)) +cc********************************************************************** + apm3x(i)=g3x*d42-rimx*d43 + apm3y(i)=g3y*d42-rimy*d43 + apm3z(i)=g3z*d42-rimz*d43 + + if(i.le.inb-1) then + ip=i+1 + rix=bx(ip)-bx(i) + riy=by(ip)-by(i) + riz=bz(ip)-bz(i) + cix=bx(ip)-bx(i-1) + ciy=by(ip)-by(i-1) + ciz=bz(ip)-bz(i-1) + gmx=rimy*riz-rimz*riy + gmy=rimz*rix-rimx*riz + gmz=rimx*riy-rimy*rix + dgm=sqrt(gmx**2+gmy**2+gmz**2) + dgm3=dgm**3 + dri=dis(i,i+1) + dri3=dri**3 + gmmgm=gmmx*gmx+gmmy*gmy+gmmz+gmz + gmmr=gmmx*rix+gmmy*riy+gmmz*riz + gmcrim_x=gmy*rimz-gmz*rimy + gmcrim_y=gmz*rimx-gmx*rimz + gmcrim_z=gmx*rimy-gmy*rimx + d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) + d_gmcrim3=d_gmcrim**3 + gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy + & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy + + if(dgm3.gt.0.0D0.and. + & dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 + & .and.d_gmcrim3.gt.0.0D0) then + d30=1.0D0/(dgm*dgmm) + d31=gmmgm/(dgm3*dgmm) + d32=gmmgm/(dgm*dgmm3) + d33=1.0D0/(dgmm*dri) + d34=gmmr/(dgmm3*dri) + d35=gmmr/(dgmm*dri3) + sd30=1.0D0/(d_gmcrim*dgmm) + sd31=gmcrim__gmm/(d_gmcrim3*dgmm) + sd32=gmcrim__gmm/(d_gmcrim*dgmm3) + + else + d30=0.0D0 + d31=0.0D0 + d32=0.0D0 + d33=0.0D0 + d34=0.0D0 + d35=0.0D0 + sd30=0.0D0 + sd31=0.0D0 + sd32=0.0D0 + endif +cc********************************************************************** + atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 + & -(ciy*gmz-ciz*gmy)*d31 + & -(gmmy*rimmz-gmmz*rimmy)*d32 + atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 + & -(ciz*gmx-cix*gmz)*d31 + & -(gmmz*rimmx-gmmx*rimmz)*d32 + atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 + & -(cix*gmy-ciy*gmx)*d31 + & -(gmmx*rimmy-gmmy*rimmx)*d32 +cc********************************************************************** + astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy + & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz + & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy + & -ciy*rimy*gmmx-rimz*gmx*rimmz) + & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) + & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) + & -sd32*(gmmy*rimmz-rimmy*gmmz) + + astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz + & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy + & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx + & +gmz*rimy*rimmz-rimz*ciz*gmmy) + & -sd31*(gmcrim_x*(cix*rimy-gmz) + & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) + & -sd32*(-gmmx*rimmz+rimmx*gmmz) + + astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz + & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx + & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy + & +rimz*ciy*gmmy+rimz*gmx*rimmx) + & -sd31*(gmcrim_x*(cix*rimz+gmy) + & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) + & -sd32*(gmmx*rimmy-rimmx*gmmy) +cc********************************************************************** + apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 + & -(gmmy*rimmz-gmmz*rimmy)*d34 + & +rix*d35 + apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 + & -(gmmz*rimmx-gmmx*rimmz)*d34 + & +riy*d35 + apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 + & -(gmmx*rimmy-gmmy*rimmx)*d34 + & +riz*d35 + endif + +c write(*,*) 'inside angvectors6' + + if(i.eq.inb-2) then + ipp=i+2 + ripx=bx(ipp)-bx(ip) + ripy=by(ipp)-by(ip) + ripz=bz(ipp)-bz(ip) + cipx=bx(ipp)-bx(i) + cipy=by(ipp)-by(i) + cipz=bz(ipp)-bz(i) + gx=riy*ripz-riz*ripy + gy=riz*ripx-rix*ripz + gz=rix*ripy-riy*ripx + ggm=gmx*gx+gmy*gy+gmz*gz + gmrp=gmx*ripx+gmy*ripy+gmz*ripz + dg=sqrt(gx**2+gy**2+gz**2) + dg3=dg**3 + drip=dis(i+1,i+2) + gcr_x=gy*riz-gz*riy + gcr_y=gz*rix-gx*riz + gcr_z=gx*riy-gy*rix + d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) + d_gcr3=d_gcr**3 + gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy + & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy + if(dgm3.gt.0.0D0.and. + & dg3.gt.0.0D0.and.drip.gt.0.0D0.and.d_gcr3.gt.0.0D0 + & ) then + d20=1.0D0/(dg*dgm) + d21=ggm/(dgm3*dg) + d22=ggm/(dgm*dg3) + d23=1.0D0/(dgm*drip) + d24=gmrp/(dgm3*drip) + sd20=1.0D0/(d_gcr*dgm) + sd21=gcr__gm/(d_gcr3*dgm) + sd22=gcr__gm/(d_gcr*dgm3) + else + d20=0.0D0 + d21=0.0D0 + d22=0.0D0 + d23=0.0D0 + d24=0.0D0 + sd20=0.0D0 + sd21=0.0D0 + sd22=0.0D0 + endif + atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 + & -(ciy*gmz-ciz*gmy)*d21 + & +(ripy*gz-ripz*gy)*d22 + atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 + & -(ciz*gmx-cix*gmz)*d21 + & +(ripz*gx-ripx*gz)*d22 + atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 + & -(cix*gmy-ciy*gmx)*d21 + & +(ripx*gy-ripy*gx)*d22 +cc********************************************************************** + astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy + & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix + & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) + & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) + & +gcr_z*(-ripz*rix+gy)) + & -sd22*(-gmy*ciz+gmz*ciy) + + astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix + & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz + & +riz*ripz*gmy) + & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) + & -gcr_z*(ripz*riy+gx)) + & -sd22*(gmx*ciz-gmz*cix) + + astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz + & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy + & -riz*gx*cix) + & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) + & +gcr_z*(ripy*riy+ripx*rix)) + & -sd22*(-gmx*ciy+gmy*cix) +cc********************************************************************** +c + apmx(i)=(ciy*ripz-ripy*ciz)*d23 + & -(ciy*gmz-ciz*gmy)*d24 + apmy(i)=(ciz*ripx-ripz*cix)*d23 + & -(ciz*gmx-cix*gmz)*d24 + apmz(i)=(cix*ripy-ripx*ciy)*d23 + & -(cix*gmy-ciy*gmx)*d24 + + endif + enddo + + return + end +c END of angvectors +c------------------------------------------------------------------------------- +C--------------------------------------------------------------------------------- + subroutine sheetforce(nca,wshet) + implicit none +C JYLEE +c this should be matched with dfa.fcm + integer maxca + parameter(maxca=800) +cc********************************************************************** + integer nca + integer i,k + integer inb,nmax,iselect + +c real*8 dfaexp(15001) + + real*8 vbeta,vbetp,vbetm + real*8 shefx(maxca,12) + real*8 shefy(maxca,12),shefz(maxca,12) + real*8 shetfx(maxca),shetfy(maxca),shetfz(maxca) + real*8 vbet(maxca,maxca) + real*8 wshet(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + + common /sheca/ bx,by,bz + common /phys1/ inb,nmax,iselect + common /shef/ shefx,shefy,shefz + common /shee/ vbeta,vbet,vbetp,vbetm + common /shetf/ shetfx,shetfy,shetfz + + inb=nca + do i=1,inb + shetfx(i)=0.0D0 + shetfy(i)=0.0D0 + shetfz(i)=0.0D0 + enddo + + do k=1,12 + do i=1,inb + shefx(i,k)=0.0D0 + shefy(i,k)=0.0D0 + shefz(i,k)=0.0D0 + enddo + enddo + + call sheetene(nca,wshet) + call sheetforce1 + + 887 format(a,1x,i6,3x,f12.8) + 888 format(a,1x,i4,1x,i4,3x,f12.8) + 889 format(a,1x,i4,3x,f12.8) + !write(2,*) 'coord : ' + do i=1,inb + !write(2,887) 'bx:',i,bx(i) + !write(2,887) 'by:',i,by(i) + !write(2,887) 'bz:',i,bz(i) + enddo + !write(2,*) 'After sheetforce1' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce5 + + !write(2,*) 'After sheetforce5' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce6 + + !write(2,*) 'After sheetforce6' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce11 + + !write(2,*) 'After sheetforce11' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + call sheetforce12 + + !write(2,*) 'After sheetforce12' + do i=1,inb + do k=1,12 + !write(2,888) 'shefx :',i,k,shefx(i,k) + !write(2,888) 'shefy :',i,k,shefy(i,k) + !write(2,888) 'shefz :',i,k,shefz(i,k) + enddo + enddo + + do i=1,inb + do k=1,12 + shetfx(i)=shetfx(i)+shefx(i,k) + shetfy(i)=shetfy(i)+shefy(i,k) + shetfz(i)=shetfz(i)+shefz(i,k) + enddo + enddo + !write(2,*) 'Beta Finished' + do i=1,inb + !write(2,889) 'shetfx : ',i,shetfx(i) + !write(2,889) 'shetfy : ',i,shetfy(i) + !write(2,889) 'shetfz : ',i,shetfz(i) + enddo + + return + end +C end sheetforce +c------------------------------------------------------------------------------- + subroutine sheetene(nca,wshet) + implicit none + integer maxca + parameter(maxca=800) +cc****************************************************************************** + +c real*8 dfaexp(15001) + real*8 dtmp1, dtmp2, dtmp3 + + real*8 vbet(maxca,maxca) + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 cph(maxca),cth(maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 ulcos(maxca) +cc********************************************************************** + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + real*8 sth(maxca) + real*8 wshet(maxca,maxca) + real*8 dp45, dm45, w_beta + real*8 c00, s00, ulnex, dnex, dca,dlhb,ulhb,dshe,dldhb,uldhb + integer nca + integer i,ip,ipp,j,jp,jpp,inb,nmax,iselect + real*8 uum, uup + real*8 vbeta,vbetp,vbetm,y,y1,y2,yshe1,yshe2,yy1,yy2 + + common /sheca/ bx,by,bz + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /coscos/ cph,cth + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + & c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shee/ vbeta,vbet,vbetp,vbetm + common /ulang/ ulcos +cc********************************************************************** + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + & astmmz,astm3x,astm3y,astm3z + common /sinsin/ sth + + real*8 r_pair_mat(maxca,maxca) +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m + common /beta_p/ r_pair_mat +C------------------------------------------------------------------------------- + r_pair_mat = 0.0d0 + do i=1,inb + do j=1,inb + r_pair_mat(i,j)=wshet(i,j) +c write(*,*) 'r_pair_mat :',i,j,r_pair_mat(i,j) + enddo + enddo +c stop +c + vbeta=0.0D0 + vbetp=0.0D0 + vbetm=0.0D0 + + do i=1,inb-7 + do j=i+4,inb-3 + ip=i+1 + ipp=i+2 + jp=j+1 + jpp=j+2 +cc********************************************************************** + y1=(cth(i)*c00+sth(i)*s00-1.0D0)**2 + & +(cth(j)*c00+sth(j)*s00-1.0D0)**2 + y1=-0.5d0*y1/dca + y2=(ulcos(i)-ulnex)**2+(ulcos(ip)-ulnex)**2 + & +(ulcos(j)-ulnex)**2+(ulcos(jp)-ulnex)**2 + y2=-0.5d0*y2/dnex + +cdebug y2=0 + + y=y1+y2 + +ci if(y.ge.-4) then +ci istrand(i,j)=1 +ci else +ci istrand(i,j)=0 +ci endif + +ci if(istrand(i,j).eq.1) then + + yy1=-0.5d0*(dis(ip,jp)-ulhb)**2/dlhb + yy2=-0.5d0*(dis(ipp,jpp)-ulhb)**2/dlhb + + + pin1(i,j)=(rx(ip,jp)*rx(ip,ipp)+ry(ip,jp)*ry(ip,ipp) + $ +rz(ip,jp)*rz(ip,ipp))/(dis(ip,jp)*dis(ip,ipp)) + pin2(i,j)=(rx(ip,jp)*rx(jp,jpp)+ry(ip,jp)*ry(jp,jpp) + $ +rz(ip,jp)*rz(jp,jpp))/(dis(ip,jp)*dis(jp,jpp)) + pin3(i,j)=(rx(ipp,jpp)*rx(ip,ipp)+ry(ipp,jpp)*ry(ip,ipp) + $ +rz(ipp,jpp)*rz(ip,ipp))/(dis(ipp,jpp)*dis(ip,ipp)) + pin4(i,j)=(rx(ipp,jpp)*rx(jp,jpp)+ry(ipp,jpp)*ry(jp,jpp) + $ +rz(ipp,jpp)*rz(jp,jpp))/(dis(ipp,jpp)*dis(jp,jpp)) + + yshe1=pin1(i,j)**2+pin2(i,j)**2 + yshe1=-0.5d0*yshe1/dshe + yshe2=pin3(i,j)**2+pin4(i,j)**2 + yshe2=-0.5d0*yshe2/dshe + +ci if((yshe1+yshe2).ge.-4) then +ci istrand_p(i,j)=1 +ci else +ci istrand_p(i,j)=0 +ci endif + + +C write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) +C write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) +C write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) +C write(*,*) 'dis(i,j):',i,j,dis(i,j) +C write(*,*) 'rx(ip,jp):',ip,jp,bx(ip),bx(jp),rx(ip,jp) +C write(*,*) 'rx(ip,ipp):',ip,ipp,bx(ip),bx(ipp),rx(ip,ipp) +C write(*,*) 'pin1:',pin1(i,j) +C write(*,*) 'pin2:',pin2(i,j) +C write(*,*) 'pin3:',pin3(i,j) +C write(*,*) 'pin4:',pin4(i,j) + +C write(*,*) 'y:',y +C write(*,*) 'yy1:',yy1 +C write(*,*) 'yy2:',yy2 +C write(*,*) 'yshe1:',yshe1 +C write(*,*) 'yshe2:',yshe2 +c + +ci if (istrand_p(i,j).eq.1) then + +cd yy1=0 +cd yy2=0 +cd yshe1=0 +cd yshe2=0 + dtmp1 = y+yy1+yshe1 + dtmp2 = y+yy2+yshe2 + dtmp3 = y+yy1+yy2+yshe1+yshe2 + +C write(*,*)'1', i,j,dtmp1,dtmp2,dtmp3 +C write(*,*)'2', y,yy1,yy2 +C write(*,*)'3', yshe1,yshe2 + +cc if (dtmp3.le.-35.0d0) then +c vbetap(i,j)=-dp45*exp(dtmp3) +cc vbetap(i,j)=0.0d0 +cc else +c vbetap(i,j)=-dp45*dfaexp(idint(-dtmp3*1000)+1) + vbetap(i,j)=-dp45*exp(dtmp3) +cc end if + +cc if (dtmp1.le.-35.0d0) then +c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) +cc vbetap1(i,j)=0.0d0 +cc else +c vbetap1(i,j)=-r_pair_mat(i+1,j+1) +c $ *dfaexp(idint(-dtmp1*1000)+1) + vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) +cc end if + +cc if (dtmp2.le.-35.0d0) then +C vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) +cc vbetap2(i,j)=0.0d0 +cc else +c vbetap2(i,j)=-r_pair_mat(i+2,j+2) +c $ *dfaexp(idint(-dtmp2*1000)+1) + vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) +cc end if + +c vbetap(i,j)=-dp45*exp(y+yy1+yy2+yshe1+yshe2) +c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(y+yy1+yshe1) +c vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(y+yy2+yshe2) + +! write(*,*) 'r_pair_mat>',i+1,j+1,r_pair_mat(i+1,j+1) +! write(*,*) 'r_pair_mat>',i+2,j+2,r_pair_mat(i+2,j+2) + +ci elseif (istrand_p(i,j).eq.0)then +ci vbetap(i,j)=0 +ci vbetap1(i,j)=0 +ci vbetap2(i,j)=0 +ci endif + + yy1=-0.5d0*(dis(ip,jpp)-ulhb)**2/dlhb + yy2=-0.5d0*(dis(ipp,jp)-ulhb)**2/dlhb + + pina1(i,j)=(rx(ip,jpp)*rx(ip,ipp)+ry(ip,jpp)*ry(ip,ipp) + $ +rz(ip,jpp)*rz(ip,ipp))/(dis(ip,jpp)*dis(ip,ipp)) + pina2(i,j)=(rx(ip,jpp)*rx(jp,jpp)+ry(ip,jpp)*ry(jp,jpp) + $ +rz(ip,jpp)*rz(jp,jpp))/(dis(ip,jpp)*dis(jp,jpp)) + pina3(i,j)=(rx(jp,ipp)*rx(ip,ipp)+ry(jp,ipp)*ry(ip,ipp) + $ +rz(jp,ipp)*rz(ip,ipp))/(dis(jp,ipp)*dis(ip,ipp)) + pina4(i,j)=(rx(jp,ipp)*rx(jp,jpp)+ry(jp,ipp)*ry(jp,jpp) + $ +rz(jp,ipp)*rz(jp,jpp))/(dis(jp,ipp)*dis(jp,jpp)) + + yshe1=pina1(i,j)**2+pina2(i,j)**2 + yshe1=-0.5d0*yshe1/dshe + yshe2=pina3(i,j)**2+pina4(i,j)**2 + yshe2=-0.5d0*yshe2/dshe + +ci if((yshe1+yshe2).ge.-4) then +ci istrand_m(i,j)=1 +ci else +ci istrand_m(i,j)=0 +ci endif + + +C write(*,*) 'pina1:',pina1(i,j) +C write(*,*) 'pina2:',pina2(i,j) +C write(*,*) 'pina3:',pina3(i,j) +C write(*,*) 'pina4:',pina4(i,j) +C write(*,*) 'yshe1:',yshe1 +C write(*,*) 'yshe2:',yshe2 +C write(*,*) 'dshe:',dshe + +ci if (istrand_m(i,j).eq.1) then + +cd yy1=0 +cd yy2=0 +cd yshe1=0 +cd yshe2=0 + + dtmp3=y+yy1+yy2+yshe1+yshe2 + dtmp1=y+yy1+yshe1 + dtmp2=y+yy2+yshe2 + +cc if(dtmp3 .le. -35.0d0) then +c vbetam(i,j)=-dm45*exp(dtmp3) +cc vbetam(i,j)=0.0d0 +cc else +c vbetam(i,j)=-dm45*dfaexp(idint(-dtmp3*1000)+1) + vbetam(i,j)=-dm45*exp(dtmp3) +cc end if + +cc if(dtmp1 .le. -35.0d0) then +c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) +cc vbetam1(i,j)=0.0d0 +cc else +c vbetam1(i,j)=-r_pair_mat(i+1,j+2) +c $ *dfaexp(idint(-dtmp1*1000)+1) + vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) +cc end if + +cc if(dtmp2.le.-35.0d0) then +c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) +cc vbetam2(i,j)=0.0d0 +cc else +c vbetam2(i,j)=-r_pair_mat(i+2,j+1) +c $ *dfaexp(idint(-dtmp2*1000)+1) + vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) +cc end if + +ci elseif (istrand_m(i,j).eq.0)then +ci vbetam(i,j)=0 +ci vbetam1(i,j)=0 +ci vbetam2(i,j)=0 +ci endif + + +c vbetam(i,j)=-dm45*exp(y+yy1+yy2+yshe1+yshe2) +c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(y+yy1+yshe1) +c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(y+yy2+yshe2) + +! write(*,*) 'r_pair_mat>',i+1,j+2,r_pair_mat(i+1,j+2) +! write(*,*) 'r_pair_mat>',i+2,j+1,r_pair_mat(i+2,j+1) + + uup = vbetap(i,j)+vbetap1(i,j)+vbetap2(i,j) + uum = vbetam(i,j)+vbetam1(i,j)+vbetam2(i,j) + +c write(*,*) 'uup,uum:', uup, uum + +c uup=vbetap1(i,j)+vbetap2(i,j) +c uum=vbetam1(i,j)+vbetam2(i,j) + + vbet(i,j)=uup+uum + vbetp=vbetp+uup + vbetm=vbetm+uum + vbeta=vbeta+vbet(i,j) + +ci elseif(istrand(i,j).eq.0)then +ci vbet(i,j)=0 +ci endif + +c write(*,*) 'uup,uum:',uup,uum +c write(*,*) 'vbetap(i,j):',vbetap(i,j) +c write(*,*) 'vbetap1(i,j):',vbetap1(i,j) +c write(*,*) 'vbetap2(i,j):',vbetap2(i,j) +c write(*,*) 'vbetam(i,j):',vbetam(i,j) +c write(*,*) 'vbetam1(i,j):',vbetam1(i,j) +c write(*,*) 'vbetam2(i,j):',vbetam2(i,j) +c write(*,*) 'uup:',uup +c write(*,*) 'uum:',uum +c write(*,*) 'vbetp:',vbetp +c write(*,*) 'vbetm:',vbetm +c write(*,*) 'vbet(i,j):',vbet(i,j) +c stop + + enddo + enddo + +! do i=1,inb-7 +! do j=i+4,inb-3 +! write(*,*) 'I,J:', i,j +! write(*,*) 'vbetap(i,j):',vbetap(i,j) +! write(*,*) 'vbetap1(i,j):',vbetap1(i,j) +! write(*,*) 'vbetap2(i,j):',vbetap2(i,j) +! write(*,*) 'vbetam(i,j):',vbetam(i,j) +! write(*,*) 'vbetam1(i,j):',vbetam1(i,j) +! write(*,*) 'vbetam2(i,j):',vbetam2(i,j) +! write(*,*) 'vbet(i,j):',vbet(i,j) +! enddo +! enddo + + return + end +c------------------------------------------------------------------------------- + subroutine sheetforce1 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbet(maxca,maxca) + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 cph(maxca),cth(maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12) + real*8 shefy(maxca,12),shefz(maxca,12) + real*8 atx(maxca),aty(maxca),atz(maxca) + real*8 atmx(maxca),atmy(maxca),atmz(maxca) + real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) + real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) + real*8 apx(maxca),apy(maxca),apz(maxca) + real*8 apmx(maxca),apmy(maxca),apmz(maxca) + real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) + real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) + real*8 ulcos(maxca) + real*8 astx(maxca),asty(maxca),astz(maxca) + real*8 astmx(maxca),astmy(maxca),astmz(maxca) + real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) + real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) + real*8 sth(maxca) + real*8 w_beta,dp45, dm45 + real*8 vbeta, vbetp, vbetm + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect + + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /coscos/ cph,cth + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, + $ atmmz,atm3x,atm3y,atm3z + common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, + $ apmmz,apm3x,apm3y,apm3z + common /shef/ shefx,shefy,shefz + common /shee/ vbeta,vbet,vbetp,vbetm + common /ulang/ ulcos +c c********************************************************************** + common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, + $ astmmz,astm3x,astm3y,astm3z + common /sinsin/ sth +C-------------------------------------------------------------------------------- +c local variables + integer i,j,im3,imm,im,ip,ipp,jm,jmm,jm3,jp,jpp + real*8 c1,v1,cc1,dmm,dmm__,fx,fy,fz,c2,v2,dmm1 + real*8 c3,v3,cc2,cc3,dmm3,dmm3__,c4,v4,c7,v7,cc7,c8,v8,cc8 + real*8 c9,v9,cc9,dmm9,dmm9__,c10,v10,dmm2,dmm1__,dmm2_1,dmm2_2 + real*8 dmm7,dmm8,dmm7__,dmm8_1,dmm8_2 +C-------------------------------------------------------------------------------- + do i=4,inb-4 + im3=i-3 + imm=i-2 + im=i-1 + c1=(cth(im3)*c00+sth(im3)*s00-1)/dca + v1=0.0D0 + do j=i+1,inb-3 + v1=v1+vbet(im3,j) + enddo + cc1=(ulcos(imm)-ulnex)/dnex + dmm=cc1/(dis(imm,im)*dis(im,i)) + dmm__=cc1*ulcos(imm)/dis(im,i)**2 + fx=rx(imm,im)*dmm-rx(im,i)*dmm__ + fy=ry(imm,im)*dmm-ry(im,i)*dmm__ + fz=rz(imm,im)*dmm-rz(im,i)*dmm__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atm3x(i)*c00+astm3x(i)*s00)*c1 + fy=fy+(atm3y(i)*c00+astm3y(i)*s00)*c1 + fz=fz+(atm3z(i)*c00+astm3z(i)*s00)*c1 + shefx(i,1)=fx*v1 + shefy(i,1)=fy*v1 + shefz(i,1)=fz*v1 + enddo + + do i=3,inb-5 + imm=i-2 + im=i-1 + ip=i+1 + c2=(cth(imm)*c00+sth(imm)*s00-1)/dca + v2=0.0D0 + do j=i+2,inb-3 + v2=v2+vbet(imm,j) + enddo + cc1=(ulcos(imm)-ulnex)/dnex + cc2=(ulcos(im)-ulnex)/dnex + dmm1=cc1/(dis(imm,im)*dis(im,i)) + dmm2=cc2/(dis(im,i)*dis(i,ip)) + dmm1__=cc1*ulcos(imm)/dis(im,i)**2 + dmm2_1=cc2*ulcos(im)/dis(im,i)**2 + dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 +cc********************************************************************** + fx=rx(imm,im)*dmm1-rx(im,i)*dmm1__+rx(i,ip)*dmm2-rx(im,i)*dmm2 + $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2 + fy=ry(imm,im)*dmm1-ry(im,i)*dmm1__+ry(i,ip)*dmm2-ry(im,i)*dmm2 + $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2 + fz=rz(imm,im)*dmm1-rz(im,i)*dmm1__+rz(i,ip)*dmm2-rz(im,i)*dmm2 + $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2 +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmmx(i)*c00+astmmx(i)*s00)*c2 + fy=fy+(atmmy(i)*c00+astmmy(i)*s00)*c2 + fz=fz+(atmmz(i)*c00+astmmz(i)*s00)*c2 + shefx(i,2)=fx*v2 + shefy(i,2)=fy*v2 + shefz(i,2)=fz*v2 + enddo + do i=2,inb-6 + im=i-1 + ip=i+1 + ipp=i+2 + c3=(cth(im)*c00+sth(im)*s00-1)/dca + v3=0.0D0 + do j=i+3,inb-3 + v3=v3+vbet(im,j) + enddo + cc2=(ulcos(im)-ulnex)/dnex + cc3=(ulcos(i)-ulnex)/dnex + dmm2=cc2/(dis(im,i)*dis(i,ip)) + dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) + dmm2_1=cc2*ulcos(im)/dis(im,i)**2 + dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 + dmm3__=cc3*ulcos(i)/dis(i,ip)**2 + fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm2-rx(im,i)*dmm2 + $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2+rx(i,ip)*dmm3__ + fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm2-ry(im,i)*dmm2 + $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2+ry(i,ip)*dmm3__ + fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm2-rz(im,i)*dmm2 + $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2+rz(i,ip)*dmm3__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmx(i)*c00+astmx(i)*s00)*c3 + fy=fy+(atmy(i)*c00+astmy(i)*s00)*c3 + fz=fz+(atmz(i)*c00+astmz(i)*s00)*c3 + shefx(i,3)=fx*v3 + shefy(i,3)=fy*v3 + shefz(i,3)=fz*v3 + enddo + do i=1,inb-7 + ip=i+1 + ipp=i+2 + c4=(cth(i)*c00+sth(i)*s00-1)/dca + v4=0.0D0 + do j=i+4,inb-3 + v4=v4+vbet(i,j) + enddo + cc3=(ulcos(i)-ulnex)/dnex + dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) + dmm3__=cc3*ulcos(i)/dis(i,ip)**2 + fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm3__ + fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm3__ + fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm3__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atx(i)*c00+astx(i)*s00)*c4 + fy=fy+(aty(i)*c00+asty(i)*s00)*c4 + fz=fz+(atz(i)*c00+astz(i)*s00)*c4 + shefx(i,4)=fx*v4 + shefy(i,4)=fy*v4 + shefz(i,4)=fz*v4 + enddo + do j=8,inb + jm3=j-3 + jmm=j-2 + jm=j-1 + c7=(cth(jm3)*c00+sth(jm3)*s00-1)/dca + v7=0.0D0 + do i=1,j-7 + v7=v7+vbet(i,jm3) + enddo + cc7=(ulcos(jmm)-ulnex)/dnex + dmm=cc7/(dis(jmm,jm)*dis(jm,j)) + dmm__=cc7*ulcos(jmm)/dis(jm,j)**2 + fx=rx(jmm,jm)*dmm-rx(jm,j)*dmm__ + fy=ry(jmm,jm)*dmm-ry(jm,j)*dmm__ + fz=rz(jmm,jm)*dmm-rz(jm,j)*dmm__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atm3x(j)*c00+astm3x(j)*s00)*c7 + fy=fy+(atm3y(j)*c00+astm3y(j)*s00)*c7 + fz=fz+(atm3z(j)*c00+astm3z(j)*s00)*c7 + shefx(j,7)=fx*v7 + shefy(j,7)=fy*v7 + shefz(j,7)=fz*v7 + enddo + do j=7,inb-1 + jm=j-1 + jmm=j-2 + jp=j+1 + c8=(cth(jmm)*c00+sth(jmm)*s00-1)/dca + v8=0.0D0 + do i=1,j-6 + v8=v8+vbet(i,jmm) + enddo + cc7=(ulcos(jmm)-ulnex)/dnex + cc8=(ulcos(jm)-ulnex)/dnex + dmm7=cc7/(dis(jmm,jm)*dis(jm,j)) + dmm8=cc8/(dis(jm,j)*dis(j,jp)) + dmm7__=cc7*ulcos(jmm)/dis(jm,j)**2 + dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 + dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 + fx=rx(jmm,jm)*dmm7+rx(j,jp)*dmm8-rx(jm,j)*dmm8 + $ -rx(jm,j)*dmm7__-rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2 + fy=ry(jmm,jm)*dmm7+ry(j,jp)*dmm8-ry(jm,j)*dmm8 + $ -ry(jm,j)*dmm7__-ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2 + fz=rz(jmm,jm)*dmm7+rz(j,jp)*dmm8-rz(jm,j)*dmm8 + $ -rz(jm,j)*dmm7__-rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2 +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmmx(j)*c00+astmmx(j)*s00)*c8 + fy=fy+(atmmy(j)*c00+astmmy(j)*s00)*c8 + fz=fz+(atmmz(j)*c00+astmmz(j)*s00)*c8 + shefx(j,8)=fx*v8 + shefy(j,8)=fy*v8 + shefz(j,8)=fz*v8 + enddo + + do j=6,inb-2 + jm=j-1 + jp=j+1 + jpp=j+2 + c9=(cth(jm)*c00+sth(jm)*s00-1)/dca + v9=0.0D0 + do i=1,j-5 + v9=v9+vbet(i,jm) + enddo + cc8=(ulcos(jm)-ulnex)/dnex + cc9=(ulcos(j)-ulnex)/dnex + dmm8=cc8/(dis(jm,j)*dis(j,jp)) + dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) + dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 + dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 + dmm9__=cc9*ulcos(j)/dis(j,jp)**2 + fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm8-rx(jm,j)*dmm8 + $ -rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2+rx(j,jp)*dmm9__ + fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm8-ry(jm,j)*dmm8 + $ -ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2+ry(j,jp)*dmm9__ + fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm8-rz(jm,j)*dmm8 + $ -rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2+rz(j,jp)*dmm9__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atmx(j)*c00+astmx(j)*s00)*c9 + fy=fy+(atmy(j)*c00+astmy(j)*s00)*c9 + fz=fz+(atmz(j)*c00+astmz(j)*s00)*c9 + shefx(j,9)=fx*v9 + shefy(j,9)=fy*v9 + shefz(j,9)=fz*v9 + enddo + + do j=5,inb-3 + jp=j+1 + jpp=j+2 + c10=(cth(j)*c00+sth(j)*s00-1)/dca + v10=0.0D0 + do i=1,j-4 + v10=v10+vbet(i,j) + enddo + cc9=(ulcos(j)-ulnex)/dnex + dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) + dmm9__=cc9*ulcos(j)/dis(j,jp)**2 + fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm9__ + fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm9__ + fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm9__ +cd fx=0 +cd fy=0 +cd fz=0 + fx=fx+(atx(j)*c00+astx(j)*s00)*c10 + fy=fy+(aty(j)*c00+asty(j)*s00)*c10 + fz=fz+(atz(j)*c00+astz(j)*s00)*c10 + shefx(j,10)=fx*v10 + shefy(j,10)=fy*v10 + shefz(j,10)=fz*v10 + enddo + + return + end +c---------------------------------------------------------------------------- + subroutine sheetforce5 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +c******************************************************************************** +c local variables + integer i,imm,im,jp,jpp,j + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z + real*8 y66x,y66y,y66z,yy6,yyy4,yyy5a,yyy5b + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b +c******************************************************************************** + do i=3,inb-5 + imm=i-2 + im=i-1 + do j=i+2,inb-3 + jp=j+1 + jpp=j+2 + +ci if(istrand(imm,j).eq.1 +ci & .and.(istrand_p(imm,j)+istrand_m(imm,j)).ge.1) then + + + yy1=-(dis(i,jpp)-ulhb)/dlhb + y1x=rx(jpp,i)/dis(i,jpp) + y1y=ry(jpp,i)/dis(i,jpp) + y1z=rz(jpp,i)/dis(i,jpp) + y11x=yy1*y1x + y11y=yy1*y1y + y11z=yy1*y1z + + yy33=1.0D0/(dis(im,jp)*dis(im,i)) + yyy3=pin1(imm,j)/(dis(im,i)**2) + yy3=-pin1(imm,j)/dshe + y3x=(yy33*rx(im,jp)-yyy3*rx(im,i))*yy3 + y3y=(yy33*ry(im,jp)-yyy3*ry(im,i))*yy3 + y3z=(yy33*rz(im,jp)-yyy3*rz(im,i))*yy3 + + yy44=1.0D0/(dis(i,jpp)*dis(im,i)) + yyy4a=pin3(imm,j)/(dis(i,jpp)**2) + yyy4b=pin3(imm,j)/(dis(im,i)**2) + yy4=-pin3(imm,j)/dshe + y4x=(yy44*(rx(i,jpp)-rx(im,i))+yyy4a*rx(i,jpp) + $ -yyy4b*rx(im,i))*yy4 + y4y=(yy44*(ry(i,jpp)-ry(im,i))+yyy4a*ry(i,jpp) + $ -yyy4b*ry(im,i))*yy4 + y4z=(yy44*(rz(i,jpp)-rz(im,i))+yyy4a*rz(i,jpp) + $ -yyy4b*rz(im,i))*yy4 + + + yy55=1.0D0/(dis(i,jpp)*dis(jp,jpp)) + yyy5=pin4(imm,j)/(dis(i,jpp)**2) + yy5=-pin4(imm,j)/dshe + y5x=(-yy55*rx(jp,jpp)+yyy5*rx(i,jpp))*yy5 + y5y=(-yy55*ry(jp,jpp)+yyy5*ry(i,jpp))*yy5 + y5z=(-yy55*rz(jp,jpp)+yyy5*rz(i,jpp))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y3x + sy1=y3y + sz1=y3z + sx2=y11x+y4x+y5x + sy2=y11y+y4y+y5y + sz2=y11z+y4z+y5z + + shefx(i,5)=shefx(i,5)-sx*vbetap(imm,j) + $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) + shefy(i,5)=shefy(i,5)-sy*vbetap(imm,j) + $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) + shefz(i,5)=shefz(i,5)-sz*vbetap(imm,j) + $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) + +! shefx(i,5)=shefx(i,5) +! $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) +! shefy(i,5)=shefy(i,5) +! $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) +! shefz(i,5)=shefz(i,5) +! $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) + + yy6=-(dis(i,jp)-uldhb)/dldhb + y6x=rx(jp,i)/dis(i,jp) + y6y=ry(jp,i)/dis(i,jp) + y6z=rz(jp,i)/dis(i,jp) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(im,jpp)*dis(im,i)) + yyy8=pina1(imm,j)/(dis(im,i)**2) + yy8=-pina1(imm,j)/dshe + y8x=(yy88*rx(im,jpp)-yyy8*rx(im,i))*yy8 + y8y=(yy88*ry(im,jpp)-yyy8*ry(im,i))*yy8 + y8z=(yy88*rz(im,jpp)-yyy8*rz(im,i))*yy8 + + yy99=1.0D0/(dis(jp,i)*dis(im,i)) + yyy9a=pina3(imm,j)/(dis(jp,i)**2) + yyy9b=pina3(imm,j)/(dis(im,i)**2) + yy9=-pina3(imm,j)/dshe + y9x=(yy99*(rx(jp,i)+rx(im,i))-yyy9a*rx(jp,i) + $ -yyy9b*rx(im,i))*yy9 + y9y=(yy99*(ry(jp,i)+ry(im,i))-yyy9a*ry(jp,i) + $ -yyy9b*ry(im,i))*yy9 + y9z=(yy99*(rz(jp,i)+rz(im,i))-yyy9a*rz(jp,i) + $ -yyy9b*rz(im,i))*yy9 + + yy1010=1.0D0/(dis(jp,i)*dis(jp,jpp)) + yyy10=pina4(imm,j)/(dis(jp,i)**2) + yy10=-pina4(imm,j)/dshe + y10x=(yy1010*rx(jp,jpp)-yyy10*rx(jp,i))*yy10 + y10y=(yy1010*ry(jp,jpp)-yyy10*ry(jp,i))*yy10 + y10z=(yy1010*rz(jp,jpp)-yyy10*rz(jp,i))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y8x + sy1=y8y + sz1=y8z + sx2=y66x+y9x+y10x + sy2=y66y+y9y+y10y + sz2=y66z+y9z+y10z + + shefx(i,5)=shefx(i,5)-sx*vbetam(imm,j) + $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) + shefy(i,5)=shefy(i,5)-sy*vbetam(imm,j) + $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) + shefz(i,5)=shefz(i,5)-sz*vbetam(imm,j) + $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) + +! shefx(i,5)=shefx(i,5) +! $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) +! shefy(i,5)=shefy(i,5) +! $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) +! shefz(i,5)=shefz(i,5) +! $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) + +ci endif + + enddo + enddo + + return + end +c--------------------------------------------------------------------------c + subroutine sheetforce6 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +cc********************************************************************** +C local variables + integer i,imm,im,jp,jpp,j,ip + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b,yyy4 + real*8 yyy3a,yyy3b,y66z,yy6,yyy5a,yyy5b +C******************************************************************************** + do i=2,inb-6 + ip=i+1 + im=i-1 + do j=i+3,inb-3 + jp=j+1 + jpp=j+2 + +ci if(istrand(im,j).eq.1 +ci & .and.(istrand_p(im,j)+istrand_m(im,j)).ge.1) then + + + yy1=-(dis(i,jp)-ulhb)/dlhb + y1x=rx(jp,i)/dis(i,jp) + y1y=ry(jp,i)/dis(i,jp) + y1z=rz(jp,i)/dis(i,jp) + y11x=yy1*y1x + y11y=yy1*y1y + y11z=yy1*y1z + + yy33=1.0D0/(dis(i,jp)*dis(i,ip)) + yyy3a=pin1(im,j)/(dis(i,jp)**2) + yyy3b=pin1(im,j)/(dis(i,ip)**2) + yy3=-pin1(im,j)/dshe + y3x=(-yy33*(rx(i,ip)+rx(i,jp))+yyy3a*rx(i,jp) + $ +yyy3b*rx(i,ip))*yy3 + y3y=(-yy33*(ry(i,ip)+ry(i,jp))+yyy3a*ry(i,jp) + $ +yyy3b*ry(i,ip))*yy3 + y3z=(-yy33*(rz(i,ip)+rz(i,jp))+yyy3a*rz(i,jp) + $ +yyy3b*rz(i,ip))*yy3 + + yy44=1.0D0/(dis(i,jp)*dis(jp,jpp)) + yyy4=pin2(im,j)/(dis(i,jp)**2) + yy4=-pin2(im,j)/dshe + y4x=(-yy44*rx(jp,jpp)+yyy4*rx(i,jp))*yy4 + y4y=(-yy44*ry(jp,jpp)+yyy4*ry(i,jp))*yy4 + y4z=(-yy44*rz(jp,jpp)+yyy4*rz(i,jp))*yy4 + + yy55=1.0D0/(dis(ip,jpp)*dis(i,ip)) + yyy5=pin3(im,j)/(dis(i,ip)**2) + yy5=-pin3(im,j)/dshe + y5x=(-yy55*rx(ip,jpp)+yyy5*rx(i,ip))*yy5 + y5y=(-yy55*ry(ip,jpp)+yyy5*ry(i,ip))*yy5 + y5z=(-yy55*rz(ip,jpp)+yyy5*rz(i,ip))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y11x+y3x+y4x + sy1=y11y+y3y+y4y + sz1=y11z+y3z+y4z + sx2=y5x + sy2=y5y + sz2=y5z + + shefx(i,6)=shefx(i,6)-sx*vbetap(im,j) + $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) + shefy(i,6)=shefy(i,6)-sy*vbetap(im,j) + $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) + shefz(i,6)=shefz(i,6)-sz*vbetap(im,j) + $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) +! shefx(i,6)=shefx(i,6) +! $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) +! shefy(i,6)=shefy(i,6) +! $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) +! shefz(i,6)=shefz(i,6) +! $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) + + yy6=-(dis(jpp,i)-uldhb)/dldhb + y6x=rx(jpp,i)/dis(jpp,i) + y6y=ry(jpp,i)/dis(jpp,i) + y6z=rz(jpp,i)/dis(jpp,i) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(i,jpp)*dis(i,ip)) + yyy8a=pina1(im,j)/(dis(i,jpp)**2) + yyy8b=pina1(im,j)/(dis(i,ip)**2) + yy8=-pina1(im,j)/dshe + y8x=(-yy88*(rx(i,jpp)+rx(i,ip))+yyy8a*rx(i,jpp) + $ +yyy8b*rx(i,ip))*yy8 + y8y=(-yy88*(ry(i,jpp)+ry(i,ip))+yyy8a*ry(i,jpp) + $ +yyy8b*ry(i,ip))*yy8 + y8z=(-yy88*(rz(i,jpp)+rz(i,ip))+yyy8a*rz(i,jpp) + $ +yyy8b*rz(i,ip))*yy8 + + yy99=1.0D0/(dis(i,jpp)*dis(jp,jpp)) + yyy9=pina2(im,j)/(dis(i,jpp)**2) + yy9=-pina2(im,j)/dshe + y9x=(-yy99*rx(jp,jpp)+yyy9*rx(i,jpp))*yy9 + y9y=(-yy99*ry(jp,jpp)+yyy9*ry(i,jpp))*yy9 + y9z=(-yy99*rz(jp,jpp)+yyy9*rz(i,jpp))*yy9 + + yy1010=1.0D0/(dis(jp,ip)*dis(i,ip)) + yyy10=pina3(im,j)/(dis(i,ip)**2) + yy10=-pina3(im,j)/dshe + y10x=(-yy1010*rx(jp,ip)+yyy10*rx(i,ip))*yy10 + y10y=(-yy1010*ry(jp,ip)+yyy10*ry(i,ip))*yy10 + y10z=(-yy1010*rz(jp,ip)+yyy10*rz(i,ip))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y66x+y8x+y9x + sy1=y66y+y8y+y9y + sz1=y66z+y8z+y9z + sx2=y10x + sy2=y10y + sz2=y10z + + shefx(i,6)=shefx(i,6)-sx*vbetam(im,j) + $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) + shefy(i,6)=shefy(i,6)-sy*vbetam(im,j) + $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) + shefz(i,6)=shefz(i,6)-sz*vbetam(im,j) + $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) + +! shefx(i,6)=shefx(i,6) +! $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) +! shefy(i,6)=shefy(i,6) +! $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) +! shefz(i,6)=shefz(i,6) +! $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) + +ci endif + + enddo + enddo + + return + end +c----------------------------------------------------------------------- + subroutine sheetforce11 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +C******************************************************************************** +C local variables + integer j,jm,jmm,ip,i,ipp + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy4,yyy5a,yyy5b,yy6 + real*8 yyy9a,yyy9b,y5z,y66z,y9z,yyy8 +C******************************************************************************** + + do j=7,inb-1 + jm=j-1 + jmm=j-2 + do i=1,j-6 + ip=i+1 + ipp=i+2 + +ci if(istrand(i,jmm).eq.1 +ci & .and.(istrand_p(i,jmm)+istrand_m(i,jmm)).ge.1) then + + + yy1=-(dis(ipp,j)-ulhb)/dlhb + y1x=rx(ipp,j)/dis(ipp,j) + y1y=ry(ipp,j)/dis(ipp,j) + y1z=rz(ipp,j)/dis(ipp,j) + y11x=yy1*y1x + y11y=yy1*y1y + y11z=yy1*y1z + + yy33=1.0D0/(dis(ip,jm)*dis(jm,j)) + yyy3=pin2(i,jmm)/(dis(jm,j)**2) + yy3=-pin2(i,jmm)/dshe + y3x=(yy33*rx(ip,jm)-yyy3*rx(jm,j))*yy3 + y3y=(yy33*ry(ip,jm)-yyy3*ry(jm,j))*yy3 + y3z=(yy33*rz(ip,jm)-yyy3*rz(jm,j))*yy3 + + yy44=1.0D0/(dis(ipp,j)*dis(ip,ipp)) + yyy4=pin3(i,jmm)/(dis(ipp,j)**2) + yy4=-pin3(i,jmm)/dshe + y4x=(yy44*rx(ip,ipp)-yyy4*rx(ipp,j))*yy4 + y4y=(yy44*ry(ip,ipp)-yyy4*ry(ipp,j))*yy4 + y4z=(yy44*rz(ip,ipp)-yyy4*rz(ipp,j))*yy4 + + yy55=1.0D0/(dis(ipp,j)*dis(jm,j)) + yyy5a=pin4(i,jmm)/(dis(ipp,j)**2) + yyy5b=pin4(i,jmm)/(dis(jm,j)**2) + yy5=-pin4(i,jmm)/dshe + y5x=(yy55*(rx(jm,j)+rx(ipp,j))-yyy5a*rx(ipp,j) + $ -yyy5b*rx(jm,j))*yy5 + y5y=(yy55*(ry(jm,j)+ry(ipp,j))-yyy5a*ry(ipp,j) + $ -yyy5b*ry(jm,j))*yy5 + y5z=(yy55*(rz(jm,j)+rz(ipp,j))-yyy5a*rz(ipp,j) + $ -yyy5b*rz(jm,j))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y3x + sy1=y3y + sz1=y3z + sx2=y11x+y4x+y5x + sy2=y11y+y4y+y5y + sz2=y11z+y4z+y5z + + shefx(j,11)=shefx(j,11)-sx*vbetap(i,jmm) + $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) + shefy(j,11)=shefy(j,11)-sy*vbetap(i,jmm) + $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) + shefz(j,11)=shefz(j,11)-sz*vbetap(i,jmm) + $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) + +! shefx(j,11)=shefx(j,11) +! $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) +! shefy(j,11)=shefy(j,11) +! $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) +! shefz(j,11)=shefz(j,11) +! $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) + + yy6=-(dis(ip,j)-uldhb)/dldhb + y6x=rx(ip,j)/dis(ip,j) + y6y=ry(ip,j)/dis(ip,j) + y6z=rz(ip,j)/dis(ip,j) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(ip,j)*dis(ip,ipp)) + yyy8=pina1(i,jmm)/(dis(ip,j)**2) + yy8=-pina1(i,jmm)/dshe + y8x=(yy88*rx(ip,ipp)-yyy8*rx(ip,j))*yy8 + y8y=(yy88*ry(ip,ipp)-yyy8*ry(ip,j))*yy8 + y8z=(yy88*rz(ip,ipp)-yyy8*rz(ip,j))*yy8 + + yy99=1.0D0/(dis(ip,j)*dis(jm,j)) + yyy9a=pina2(i,jmm)/(dis(ip,j)**2) + yyy9b=pina2(i,jmm)/(dis(jm,j)**2) + yy9=-pina2(i,jmm)/dshe + y9x=(yy99*(rx(jm,j)+rx(ip,j))-yyy9a*rx(ip,j) + $ -yyy9b*rx(jm,j))*yy9 + y9y=(yy99*(ry(jm,j)+ry(ip,j))-yyy9a*ry(ip,j) + $ -yyy9b*ry(jm,j))*yy9 + y9z=(yy99*(rz(jm,j)+rz(ip,j))-yyy9a*rz(ip,j) + $ -yyy9b*rz(jm,j))*yy9 + + yy1010=1.0D0/(dis(jm,ipp)*dis(jm,j)) + yyy10=pina4(i,jmm)/(dis(jm,j)**2) + yy10=-pina4(i,jmm)/dshe + y10x=(yy1010*rx(jm,ipp)-yyy10*rx(jm,j))*yy10 + y10y=(yy1010*ry(jm,ipp)-yyy10*ry(jm,j))*yy10 + y10z=(yy1010*rz(jm,ipp)-yyy10*rz(jm,j))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y66x+y8x+y9x + sy1=y66y+y8y+y9y + sz1=y66z+y8z+y9z + sx2=y10x + sy2=y10y + sz2=y10z + + shefx(j,11)=shefx(j,11)-sx*vbetam(i,jmm) + $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) + shefy(j,11)=shefy(j,11)-sy*vbetam(i,jmm) + $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) + shefz(j,11)=shefz(j,11)-sz*vbetam(i,jmm) + $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) + +! shefx(j,11)=shefx(j,11) +! $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) +! shefy(j,11)=shefy(j,11) +! $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) +! shefz(j,11)=shefz(j,11) +! $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) + +ci endif + + enddo + enddo + + return + end +c----------------------------------------------------------------------- + subroutine sheetforce12 + implicit none + integer maxca + parameter(maxca=800) +cc********************************************************************** + real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) + real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) + real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) + real*8 pin1(maxca,maxca),pin2(maxca,maxca) + real*8 pin3(maxca,maxca),pin4(maxca,maxca) + real*8 pina1(maxca,maxca),pina2(maxca,maxca) + real*8 pina3(maxca,maxca),pina4(maxca,maxca) + real*8 rx(maxca,maxca) + real*8 ry(maxca,maxca),rz(maxca,maxca) + real*8 bx(maxca),by(maxca),bz(maxca) + real*8 dis(maxca,maxca) + real*8 shefx(maxca,12),shefy(maxca,12) + real*8 shefz(maxca,12) + real*8 dp45,dm45,w_beta + real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + integer inb,nmax,iselect +cc********************************************************************** + common /phys1/ inb,nmax,iselect + common /kyori2/ dis + common /difvec/ rx,ry,rz + common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, + $ c00,s00,ulnex,dnex + common /sheconst/ dp45,dm45,w_beta + common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 + common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 + common /shef/ shefx,shefy,shefz +ci integer istrand(maxca,maxca) +ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) +ci common /shetest/ istrand,istrand_p,istrand_m +cc********************************************************************** +C local variables + integer j,jm,jmm,ip,i,ipp,jp + real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z + real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z + real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y,y66z + real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z + real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy10a,yyy10b,yy6,yyy8 +!c*************************************************************************c + do j=6,inb-2 + jp=j+1 + jm=j-1 + do i=1,j-5 + ip=i+1 + ipp=i+2 + +ci if(istrand(i,jm).eq.1 +ci & .and.(istrand_p(i,jm)+istrand_m(i,jm)).ge.1) then + + + yy1=-(dis(ip,j)-ulhb)/dlhb + y1x=rx(ip,j)/dis(ip,j) + y1y=ry(ip,j)/dis(ip,j) + y1z=rz(ip,j)/dis(ip,j) + y11x=y1x*yy1 + y11y=y1y*yy1 + y11z=y1z*yy1 + + yy33=1.0D0/(dis(ip,j)*dis(ip,ipp)) + yyy3=pin1(i,jm)/(dis(ip,j)**2) + yy3=-pin1(i,jm)/dshe + y3x=(yy33*rx(ip,ipp)-yyy3*rx(ip,j))*yy3 + y3y=(yy33*ry(ip,ipp)-yyy3*ry(ip,j))*yy3 + y3z=(yy33*rz(ip,ipp)-yyy3*rz(ip,j))*yy3 + yy44=1.0D0/(dis(ip,j)*dis(j,jp)) + + yyy4a=pin2(i,jm)/(dis(ip,j)**2) + yyy4b=pin2(i,jm)/(dis(j,jp)**2) + yy4=-pin2(i,jm)/dshe + y4x=(yy44*(rx(j,jp)-rx(ip,j))-yyy4a*rx(ip,j) + $ +yyy4b*rx(j,jp))*yy4 + y4y=(yy44*(ry(j,jp)-ry(ip,j))-yyy4a*ry(ip,j) + $ +yyy4b*ry(j,jp))*yy4 + y4z=(yy44*(rz(j,jp)-rz(ip,j))-yyy4a*rz(ip,j) + $ +yyy4b*rz(j,jp))*yy4 + + yy55=1.0D0/(dis(ipp,jp)*dis(j,jp)) + yyy5=pin4(i,jm)/(dis(j,jp)**2) + yy5=-pin4(i,jm)/dshe + y5x=(-yy55*rx(ipp,jp)+yyy5*rx(j,jp))*yy5 + y5y=(-yy55*ry(ipp,jp)+yyy5*ry(j,jp))*yy5 + y5z=(-yy55*rz(ipp,jp)+yyy5*rz(j,jp))*yy5 + + sx=y11x+y3x+y4x+y5x + sy=y11y+y3y+y4y+y5y + sz=y11z+y3z+y4z+y5z + + sx1=y11x+y3x+y4x + sy1=y11y+y3y+y4y + sz1=y11z+y3z+y4z + sx2=y5x + sy2=y5y + sz2=y5z + + shefx(j,12)=shefx(j,12)-sx*vbetap(i,jm) + $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) + shefy(j,12)=shefy(j,12)-sy*vbetap(i,jm) + $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) + shefz(j,12)=shefz(j,12)-sz*vbetap(i,jm) + $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) + +! shefx(j,12)=shefx(j,12) +! $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) +! shefy(j,12)=shefy(j,12) +! $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) +! shefz(j,12)=shefz(j,12) +! $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) + + yy6=-(dis(ipp,j)-uldhb)/dldhb + y6x=rx(ipp,j)/dis(ipp,j) + y6y=ry(ipp,j)/dis(ipp,j) + y6z=rz(ipp,j)/dis(ipp,j) + y66x=yy6*y6x + y66y=yy6*y6y + y66z=yy6*y6z + + yy88=1.0D0/(dis(ip,jp)*dis(j,jp)) + yyy8=pina2(i,jm)/(dis(j,jp)**2) + yy8=-pina2(i,jm)/dshe + y8x=(-yy88*rx(ip,jp)+yyy8*rx(j,jp))*yy8 + y8y=(-yy88*ry(ip,jp)+yyy8*ry(j,jp))*yy8 + y8z=(-yy88*rz(ip,jp)+yyy8*rz(j,jp))*yy8 + + yy99=1.0D0/(dis(j,ipp)*dis(ip,ipp)) + yyy9=pina3(i,jm)/(dis(j,ipp)**2) + yy9=-pina3(i,jm)/dshe + y9x=(-yy99*rx(ip,ipp)+yyy9*rx(j,ipp))*yy9 + y9y=(-yy99*ry(ip,ipp)+yyy9*ry(j,ipp))*yy9 + y9z=(-yy99*rz(ip,ipp)+yyy9*rz(j,ipp))*yy9 + + yy1010=1.0D0/(dis(j,ipp)*dis(j,jp)) + yyy10a=pina4(i,jm)/(dis(j,ipp)**2) + yyy10b=pina4(i,jm)/(dis(j,jp)**2) + yy10=-pina4(i,jm)/dshe + y10x=(-yy1010*(rx(j,ipp)+rx(j,jp))+yyy10a*rx(j,ipp) + $ +yyy10b*rx(j,jp))*yy10 + y10y=(-yy1010*(ry(j,ipp)+ry(j,jp))+yyy10a*ry(j,ipp) + $ +yyy10b*ry(j,jp))*yy10 + y10z=(-yy1010*(rz(j,ipp)+rz(j,jp))+yyy10a*rz(j,ipp) + $ +yyy10b*rz(j,jp))*yy10 + + sx=y66x+y8x+y9x+y10x + sy=y66y+y8y+y9y+y10y + sz=y66z+y8z+y9z+y10z + + sx1=y8x + sy1=y8y + sz1=y8z + sx2=y66x+y9x+y10x + sy2=y66y+y9y+y10y + sz2=y66z+y9z+y10z + + shefx(j,12)=shefx(j,12)-sx*vbetam(i,jm) + $ -sx1*vbetam1(i,jm)-sx2*vbetam2(i,jm) + shefy(j,12)=shefy(j,12)-sy*vbetam(i,jm) + $ -sy1*vbetam1(i,jm)-sy2*vbetam2(i,jm) + shefz(j,12)=shefz(j,12)-sz*vbetam(i,jm) + $ -sz1*vbetam1(i,jm)-sz2*vbetam2(i,jm) + +ci endif + + ENDDO + ENDDO + + RETURN + END +C=============================================================================== diff --git a/source/wham/src/enecalc1.F b/source/wham/src/enecalc1.F index 01e5684..3d2b6c6 100644 --- a/source/wham/src/enecalc1.F +++ b/source/wham/src/enecalc1.F @@ -33,7 +33,8 @@ double precision rmsnat,gyrate external rmsnat,gyrate double precision tole /1.0d-1/ - integer i,itj,ii,iii,j,k,l,licz + integer i,itj,ii,iii,j,k,l,licz,scme,itmp + integer ires integer ir,ib,ipar,iparm integer iscor,islice real*4 csingle(3,maxres2) @@ -159,7 +160,14 @@ c & " kfac",kfac,"quot",quot," fT",fT call enerprint(energia(0),fT) c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) c write (iout,*) "ftors",ftors -c call intout + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + call intout #endif if (energia(0).ge.1.0d20) then write (iout,*) "NaNs detected in some of the energy", @@ -196,9 +204,12 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) & iii+1,indstart(me1)+iii," T", & 1.0d0/(1.987D-3*beta_h(ib,ipar)) call enerprint(energia(0),fT) + itmp=ipdb + ipdb=iout call pdbout(iii+1,beta_h(ib,ipar), & eini,energia(0),0.0d0,rmsdev) write (iout,*) + ipdb=itmp errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) @@ -215,7 +226,7 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) endif endif potE(iii+1,iparm)=energia(0) - do k=1,21 + do k=1,max_ene enetb(k,iii+1,iparm)=energia(k) enddo c write(iout,*) "iCHUJ TU STRZELI",i,iii,entfac(i) @@ -273,6 +284,7 @@ c & " snk",snk_p(iR,ib,ipar) write (iout,*) "Me",me," scount",scount(me) call flush(iout) c Master gathers updated numbers of conformations written by all procs. + scme = scount(me) call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1, & MPI_INTEGER, WHAM_COMM, IERROR) indstart(0)=1 diff --git a/source/wham/src/energy_p_new.F b/source/wham/src/energy_p_new.F index 13fe796..816e38e 100644 --- a/source/wham/src/energy_p_new.F +++ b/source/wham/src/energy_p_new.F @@ -22,6 +22,7 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' + include 'COMMON.CONTROL' double precision fact(6) cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot cd print *,'nnt=',nnt,' nct=',nct @@ -102,6 +103,27 @@ c print *,ecorr,ecorr5,ecorr6,eturn6 if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif + + +c write(iout,*) "TEST_ENE1 constr_homology=",constr_homology + if (constr_homology.ge.1) then + call e_modeller(ehomology_constr) + else + ehomology_constr=0.0d0 + endif + +c write(iout,*) "TEST_ENE1 ehomology_constr=",ehomology_constr + +C BARTEK for dfa test! + if (wdfa_dist.gt.0) call edfad(edfadis) +c write(iout,*)'edfad is finished!', wdfa_dist,edfadis + if (wdfa_tor.gt.0) call edfat(edfator) +c write(iout,*)'edfat is finished!', wdfa_tor,edfator + if (wdfa_nei.gt.0) call edfan(edfanei) +c write(iout,*)'edfan is finished!', wdfa_nei,edfanei + if (wdfa_beta.gt.0) call edfab(edfabet) +c write(iout,*)'edfab is finished!', wdfa_beta,edfabet + c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t #ifdef SPLITELE etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees @@ -111,7 +133,9 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr + & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei + & +wdfa_beta*edfabet #else etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2 & +welec*fact(1)*(ees+evdw1) @@ -120,7 +144,9 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ehomology_constr + & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei + & +wdfa_beta*edfabet #endif energia(0)=etot energia(1)=evdw @@ -154,6 +180,11 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t energia(19)=esccor energia(20)=edihcnstr energia(21)=evdw_t + energia(22)=ehomology_constr + energia(23)=edfadis + energia(24)=edfator + energia(25)=edfanei + energia(26)=edfabet c if (dyn_ss) call dyn_set_nss c detecting NaNQ #ifdef ISNAN @@ -192,7 +223,11 @@ C & wcorr5*fact(4)*gradcorr5(j,i)+ & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ - & wsccor*fact(2)*gsccorc(j,i) + & wsccor*fact(2)*gsccorc(j,i)+ + & wdfa_dist*gdfad(j,i)+ + & wdfa_tor*gdfat(j,i)+ + & wdfa_nei*gdfan(j,i)+ + & wdfa_beta*gdfab(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ @@ -211,7 +246,11 @@ C & wcorr5*fact(4)*gradcorr5(j,i)+ & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ - & wsccor*fact(2)*gsccorc(j,i) + & wsccor*fact(2)*gsccorc(j,i)+ + & wdfa_dist*gdfad(j,i)+ + & wdfa_tor*gdfat(j,i)+ + & wdfa_nei*gdfan(j,i)+ + & wdfa_beta*gdfab(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ @@ -269,6 +308,11 @@ C------------------------------------------------------------------------ esccor=energia(19) edihcnstr=energia(20) estr=energia(18) + ehomology_constr=energia(22) + edfadis=energia(23) + edfator=energia(24) + edfanei=energia(25) + edfabet=energia(26) #ifdef SPLITELE write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1, & wvdwpp, @@ -277,7 +321,9 @@ C------------------------------------------------------------------------ & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), - & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot + & esccor,wsccor*fact(1),edihcnstr,ehomology_constr,ebr*nss, + & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet, + & wdfa_beta,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -299,7 +345,12 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/ + & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/ + & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/ + & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/ & 'ETOT= ',1pE16.6,' (total)') #else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond, @@ -308,7 +359,9 @@ C------------------------------------------------------------------------ & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2), & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3), & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor, - & edihcnstr,ebr*nss,etot + & edihcnstr,ehomology_constr,ebr*nss, + & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei,edfabet, + & wdfa_beta,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -329,7 +382,12 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/ + & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/ + & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/ + & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/ & 'ETOT= ',1pE16.6,' (total)') #endif return @@ -3086,6 +3144,594 @@ C return end C-------------------------------------------------------------------------- +c MODELLER restraint function + subroutine e_modeller(ehomology_constr) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + + integer nnn, i, j, k, ki, irec, l + integer katy, odleglosci, test7 + real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template) + real*8 distance(max_template),distancek(max_template), + & min_odl,godl(max_template),dih_diff(max_template) + +c +c FP - 30/10/2014 Temporary specifications for homology restraints +c + double precision utheta_i,gutheta_i,sum_gtheta,sum_sgtheta, + & sgtheta + double precision, dimension (maxres) :: guscdiff,usc_diff + double precision, dimension (max_template) :: + & gtheta,dscdiff,uscdiffk,guscdiff2,guscdiff3, + & theta_diff + + include 'COMMON.SBRIDGE' + include 'COMMON.CHAIN' + include 'COMMON.GEO' + include 'COMMON.DERIV' + include 'COMMON.LOCAL' + include 'COMMON.INTERACT' + include 'COMMON.VAR' + include 'COMMON.IOUNITS' + include 'COMMON.CONTROL' + include 'COMMON.HOMRESTR' +c + include 'COMMON.SETUP' + include 'COMMON.NAMES' + + do i=1,19 + distancek(i)=9999999.9 + enddo + + odleg=0.0d0 + +c Pseudo-energy and gradient from homology restraints (MODELLER-like +c function) +C AL 5/2/14 - Introduce list of restraints +c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d +#ifdef DEBUG + write(iout,*) "------- dist restrs start -------" +#endif + do ii = link_start_homo,link_end_homo + i = ires_homo(ii) + j = jres_homo(ii) + dij=dist(i,j) +c write (iout,*) "dij(",i,j,") =",dij + do k=1,constr_homology + distance(k)=odl(k,ii)-dij +c write (iout,*) "distance(",k,") =",distance(k) +c +c For Gaussian-type Urestr +c + distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument +c write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii) +c write (iout,*) "distancek(",k,") =",distancek(k) +c distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii) +c +c For Lorentzian-type Urestr +c + if (waga_dist.lt.0.0d0) then + sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii)) + distancek(k)=distance(k)**2/(sigma_odlir(k,ii)* + & (distance(k)**2+sigma_odlir(k,ii)**2)) + endif + enddo + + min_odl=minval(distancek) +c write (iout,* )"min_odl",min_odl +#ifdef DEBUG + write (iout,*) "ij dij",i,j,dij + write (iout,*) "distance",(distance(k),k=1,constr_homology) + write (iout,*) "distancek",(distancek(k),k=1,constr_homology) + write (iout,* )"min_odl",min_odl +#endif + odleg2=0.0d0 + do k=1,constr_homology +c Nie wiem po co to liczycie jeszcze raz! +c odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/ +c & (2*(sigma_odl(i,j,k))**2)) + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + godl(k)=dexp(-distancek(k)+min_odl) + odleg2=odleg2+godl(k) +c +c For Lorentzian-type Urestr +c + else + odleg2=odleg2+distancek(k) + endif + +ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3, +ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=", +ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1), +ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k) + + enddo +c write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents +c write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps +#ifdef DEBUG + write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents + write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps +#endif + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + odleg=odleg-dLOG(odleg2/constr_homology)+min_odl +c +c For Lorentzian-type Urestr +c + else + odleg=odleg+odleg2/constr_homology + endif +c +#ifdef GRAD +c write (iout,*) "odleg",odleg ! sum of -ln-s +c Gradient +c +c For Gaussian-type Urestr +c + if (waga_dist.ge.0.0d0) sum_godl=odleg2 + sum_sgodl=0.0d0 + do k=1,constr_homology +c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) +c & *waga_dist)+min_odl +c sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist +c + if (waga_dist.ge.0.0d0) then +c For Gaussian-type Urestr +c + sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd +c +c For Lorentzian-type Urestr +c + else + sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+ + & sigma_odlir(k,ii)**2)**2) + endif + sum_sgodl=sum_sgodl+sgodl + +c sgodl2=sgodl2+sgodl +c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1" +c write(iout,*) "constr_homology=",constr_homology +c write(iout,*) i, j, k, "TEST K" + enddo + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + grad_odl3=waga_homology(iset)*waga_dist + & *sum_sgodl/(sum_godl*dij) +c +c For Lorentzian-type Urestr +c + else +c Original grad expr modified by analogy w Gaussian-type Urestr grad +c grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl + grad_odl3=-waga_homology(iset)*waga_dist* + & sum_sgodl/(constr_homology*dij) + endif +c +c grad_odl3=sum_sgodl/(sum_godl*dij) + + +c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2" +c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2), +c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) + +ccc write(iout,*) godl, sgodl, grad_odl3 + +c grad_odl=grad_odl+grad_odl3 + + do jik=1,3 + ggodl=grad_odl3*(c(jik,i)-c(jik,j)) +ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1)) +ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl, +ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) + ghpbc(jik,i)=ghpbc(jik,i)+ggodl + ghpbc(jik,j)=ghpbc(jik,j)-ggodl +ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl, +ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) +c if (i.eq.25.and.j.eq.27) then +c write(iout,*) "jik",jik,"i",i,"j",j +c write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl +c write(iout,*) "grad_odl3",grad_odl3 +c write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j) +c write(iout,*) "ggodl",ggodl +c write(iout,*) "ghpbc(",jik,i,")", +c & ghpbc(jik,i),"ghpbc(",jik,j,")", +c & ghpbc(jik,j) +c endif + enddo +#endif +ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=", +ccc & dLOG(odleg2),"-odleg=", -odleg + + enddo ! ii-loop for dist +#ifdef DEBUG + write(iout,*) "------- dist restrs end -------" +c if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or. +c & waga_d.eq.1.0d0) call sum_gradient +#endif +c Pseudo-energy and gradient from dihedral-angle restraints from +c homology templates +c write (iout,*) "End of distance loop" +c call flush(iout) + kat=0.0d0 +c write (iout,*) idihconstr_start_homo,idihconstr_end_homo +#ifdef DEBUG + write(iout,*) "------- dih restrs start -------" + do i=idihconstr_start_homo,idihconstr_end_homo + write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg) + enddo +#endif + do i=idihconstr_start_homo,idihconstr_end_homo + kat2=0.0d0 +c betai=beta(i,i+1,i+2,i+3) + betai = phi(i+3) +c write (iout,*) "betai =",betai + do k=1,constr_homology + dih_diff(k)=pinorm(dih(k,i)-betai) +c write (iout,*) "dih_diff(",k,") =",dih_diff(k) +c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)= +c & -(6.28318-dih_diff(i,k)) +c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)= +c & 6.28318+dih_diff(i,k) + + kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument +c kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i) + gdih(k)=dexp(kat3) + kat2=kat2+gdih(k) +c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3) +c write(*,*)"" + enddo +c write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps +c write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps +#ifdef DEBUG + write (iout,*) "i",i," betai",betai," kat2",kat2 + write (iout,*) "gdih",(gdih(k),k=1,constr_homology) +#endif + if (kat2.le.1.0d-14) cycle + kat=kat-dLOG(kat2/constr_homology) +c write (iout,*) "kat",kat ! sum of -ln-s + +ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=", +ccc & dLOG(kat2), "-kat=", -kat + +#ifdef GRAD +c ---------------------------------------------------------------------- +c Gradient +c ---------------------------------------------------------------------- + + sum_gdih=kat2 + sum_sgdih=0.0d0 + do k=1,constr_homology + sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd +c sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle + sum_sgdih=sum_sgdih+sgdih + enddo +c grad_dih3=sum_sgdih/sum_gdih + grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih + +c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3 +ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3, +ccc & gloc(nphi+i-3,icg) + gloc(i,icg)=gloc(i,icg)+grad_dih3 +c if (i.eq.25) then +c write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg) +c endif +ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3, +ccc & gloc(nphi+i-3,icg) +#endif + enddo ! i-loop for dih +#ifdef DEBUG + write(iout,*) "------- dih restrs end -------" +#endif + +c Pseudo-energy and gradient for theta angle restraints from +c homology templates +c FP 01/15 - inserted from econstr_local_test.F, loop structure +c adapted + +c +c For constr_homology reference structures (FP) +c +c Uconst_back_tot=0.0d0 + Eval=0.0d0 + Erot=0.0d0 +c Econstr_back legacy +#ifdef GRAD + do i=1,nres +c do i=ithet_start,ithet_end + dutheta(i)=0.0d0 +c enddo +c do i=loc_start,loc_end + do j=1,3 + duscdiff(j,i)=0.0d0 + duscdiffx(j,i)=0.0d0 + enddo + enddo +#endif +c +c do iref=1,nref +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "waga_theta",waga_theta + if (waga_theta.gt.0.0d0) then +#ifdef DEBUG + write (iout,*) "usampl",usampl + write(iout,*) "------- theta restrs start -------" +c do i=ithet_start,ithet_end +c write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg) +c enddo +#endif +c write (iout,*) "maxres",maxres,"nres",nres + + do i=ithet_start,ithet_end +c +c do i=1,nfrag_back +c ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) +c +c Deviation of theta angles wrt constr_homology ref structures +c + utheta_i=0.0d0 ! argument of Gaussian for single k + gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures +c do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop +c over residues in a fragment +c write (iout,*) "theta(",i,")=",theta(i) + do k=1,constr_homology +c +c dtheta_i=theta(j)-thetaref(j,iref) +c dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing + theta_diff(k)=thetatpl(k,i)-theta(i) +c + utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument +c utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta? + gtheta(k)=dexp(utheta_i) ! + min_utheta_i? + gutheta_i=gutheta_i+dexp(utheta_i) ! Sum of Gaussians (pk) +c Gradient for single Gaussian restraint in subr Econstr_back +c dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) +c + enddo +c write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps +c write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps + +c +#ifdef GRAD +c Gradient for multiple Gaussian restraint + sum_gtheta=gutheta_i + sum_sgtheta=0.0d0 + do k=1,constr_homology +c New generalized expr for multiple Gaussian from Econstr_back + sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd +c +c sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form? + sum_sgtheta=sum_sgtheta+sgtheta ! cum variable + enddo +c grad_theta3=sum_sgtheta/sum_gtheta 1/*theta(i)? s. line below +c grad_theta3=sum_sgtheta/sum_gtheta +c +c Final value of gradient using same var as in Econstr_back + dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta + & *waga_homology(iset) +c dutheta(i)=sum_sgtheta/sum_gtheta +c +c Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight +#endif + Eval=Eval-dLOG(gutheta_i/constr_homology) +c write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps +c write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s +c Uconst_back=Uconst_back+utheta(i) + enddo ! (i-loop for theta) +#ifdef DEBUG + write(iout,*) "------- theta restrs end -------" +#endif + endif +c +c Deviation of local SC geometry +c +c Separation of two i-loops (instructed by AL - 11/3/2014) +c +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +c write (iout,*) "waga_d",waga_d + +#ifdef DEBUG + write(iout,*) "------- SC restrs start -------" + write (iout,*) "Initial duscdiff,duscdiffx" + do i=loc_start,loc_end + write (iout,*) i,(duscdiff(jik,i),jik=1,3), + & (duscdiffx(jik,i),jik=1,3) + enddo +#endif + do i=loc_start,loc_end + usc_diff_i=0.0d0 ! argument of Gaussian for single k + guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures +c do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy +c write(iout,*) "xxtab, yytab, zztab" +c write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i) + do k=1,constr_homology +c + dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str? +c Original sign inverted for calc of gradients (s. Econstr_back) + dyy=-yytpl(k,i)+yytab(i) ! ibid y + dzz=-zztpl(k,i)+zztab(i) ! ibid z +c write(iout,*) "dxx, dyy, dzz" +c write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz +c + usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument +c usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d? +c uscdiffk(k)=usc_diff(i) + guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff + guscdiff(i)=guscdiff(i)+dexp(usc_diff_i) !Sum of Gaussians (pk) +c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), +c & xxref(j),yyref(j),zzref(j) + enddo +c +c Gradient +c +c Generalized expression for multiple Gaussian acc to that for a single +c Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014) +c +c Original implementation +c sum_guscdiff=guscdiff(i) +c +c sum_sguscdiff=0.0d0 +c do k=1,constr_homology +c sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d? +c sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff +c sum_sguscdiff=sum_sguscdiff+sguscdiff +c enddo +c +c Implementation of new expressions for gradient (Jan. 2015) +c +c grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !? +#ifdef GRAD + do k=1,constr_homology +c +c New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong +c before. Now the drivatives should be correct +c + dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str? +c Original sign inverted for calc of gradients (s. Econstr_back) + dyy=-yytpl(k,i)+yytab(i) ! ibid y + dzz=-zztpl(k,i)+zztab(i) ! ibid z +c +c New implementation +c + sum_guscdiff=guscdiff2(k)*!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong! + & sigma_d(k,i) ! for the grad wrt r' +c sum_sguscdiff=sum_sguscdiff+sum_guscdiff +c +c +c New implementation + sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff + do jik=1,3 + duscdiff(jik,i-1)=duscdiff(jik,i-1)+ + & sum_guscdiff*(dXX_C1tab(jik,i)*dxx+ + & dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i) + duscdiff(jik,i)=duscdiff(jik,i)+ + & sum_guscdiff*(dXX_Ctab(jik,i)*dxx+ + & dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i) + duscdiffx(jik,i)=duscdiffx(jik,i)+ + & sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+ + & dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i) +c +#ifdef DEBUG + write(iout,*) "jik",jik,"i",i + write(iout,*) "dxx, dyy, dzz" + write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz + write(iout,*) "guscdiff2(",k,")",guscdiff2(k) +c write(iout,*) "sum_sguscdiff",sum_sguscdiff +cc write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i) +c write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i) +c write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i) +c write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i) +c write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i) +c write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i) +c write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i) +c write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i) +c write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i) +c write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1) +c write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i) +c write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i) +c endif +#endif + enddo + enddo +#endif +c +c uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required? +c usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ? +c +c write (iout,*) i," uscdiff",uscdiff(i) +c +c Put together deviations from local geometry + +c Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ +c & wfrag_back(3,i,iset)*uscdiff(i) + Erot=Erot-dLOG(guscdiff(i)/constr_homology) +c write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps +c write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s +c Uconst_back=Uconst_back+usc_diff(i) +c +c Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?) +c +c New implment: multiplied by sum_sguscdiff +c + + enddo ! (i-loop for dscdiff) + +c endif + +#ifdef DEBUG + write(iout,*) "------- SC restrs end -------" + write (iout,*) "------ After SC loop in e_modeller ------" + do i=loc_start,loc_end + write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3) + write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3) + enddo + if (waga_theta.eq.1.0d0) then + write (iout,*) "in e_modeller after SC restr end: dutheta" + do i=ithet_start,ithet_end + write (iout,*) i,dutheta(i) + enddo + endif + if (waga_d.eq.1.0d0) then + write (iout,*) "e_modeller after SC loop: duscdiff/x" + do i=1,nres + write (iout,*) i,(duscdiff(j,i),j=1,3) + write (iout,*) i,(duscdiffx(j,i),j=1,3) + enddo + endif +#endif + +c Total energy from homology restraints +#ifdef DEBUG + write (iout,*) "odleg",odleg," kat",kat + write (iout,*) "odleg",odleg," kat",kat + write (iout,*) "Eval",Eval," Erot",Erot + write (iout,*) "waga_homology(",iset,")",waga_homology(iset) + write (iout,*) "waga_dist ",waga_dist,"waga_angle ",waga_angle + write (iout,*) "waga_theta ",waga_theta,"waga_d ",waga_d +#endif +c +c Addition of energy of theta angle and SC local geom over constr_homologs ref strs +c +c ehomology_constr=odleg+kat +c +c For Lorentzian-type Urestr +c + + if (waga_dist.ge.0.0d0) then +c +c For Gaussian-type Urestr +c + ehomology_constr=(waga_dist*odleg+waga_angle*kat+ + & waga_theta*Eval+waga_d*Erot)*waga_homology(iset) +c write (iout,*) "ehomology_constr=",ehomology_constr + else +c +c For Lorentzian-type Urestr +c + ehomology_constr=(-waga_dist*odleg+waga_angle*kat+ + & waga_theta*Eval+waga_d*Erot)*waga_homology(iset) +c write (iout,*) "ehomology_constr=",ehomology_constr + endif +c write (iout,*) "odleg",odleg," kat",kat," Uconst_back",Uconst_back +c write (iout,*) "ehomology_constr",ehomology_constr +c ehomology_constr=odleg+kat+Uconst_back + return + + 748 format(a8,f12.3,a6,f12.3,a7,f12.3) + 747 format(a12,i4,i4,i4,f8.3,f8.3) + 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3) + 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3) + 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, + & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3) + end +c----------------------------------------------------------------------- subroutine ebond(estr) c c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds @@ -3437,6 +4083,8 @@ C etheta=0.0D0 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end + if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + & (itype(i).eq.ntyp1)) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -3446,7 +4094,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3) then + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -3460,13 +4108,13 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) enddo else phii=0.0d0 - ityp1=nthetyp+1 + ityp1=ithetyp(itype(i-2)) do k=1,nsingle cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres) then + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 diff --git a/source/wham/src/include_unres/COMMON.DERIV b/source/wham/src/include_unres/COMMON.DERIV index 79f8630..596a365 100644 --- a/source/wham/src/include_unres/COMMON.DERIV +++ b/source/wham/src/include_unres/COMMON.DERIV @@ -3,7 +3,7 @@ & gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn, & gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc, & g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc, - & gscloc,gsclocx + & gscloc,gsclocx,gdfad,gdfat,gdfan,gdfab integer nfl,icg logical calc_grad common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), @@ -19,7 +19,9 @@ & gel_loc_turn6(maxvar),gcorr_loc(maxvar), & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), & gsccorx(3,maxres),gsccor_loc(maxres), - & gscloc(3,maxres),gsclocx(3,maxres),nfl,icg,calc_grad + & gscloc(3,maxres),gsclocx(3,maxres), + & gdfad(3,maxres),gdfat(3,maxres),gdfan(3,maxres),gdfab(3,maxres), + & nfl,icg,calc_grad double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), diff --git a/source/wham/src/include_unres/COMMON.FFIELD b/source/wham/src/include_unres/COMMON.FFIELD index 0c169f7..cf03bcd 100644 --- a/source/wham/src/include_unres/COMMON.FFIELD +++ b/source/wham/src/include_unres/COMMON.FFIELD @@ -6,11 +6,13 @@ C----------------------------------------------------------------------- double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, & wturn6,wvdwpp,wbond,weights,scal14,cutoff_corr,delt_corr, + & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, & r0_corr integer ipot,n_ene_comp common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, & wturn6,wvdwpp,wbond,weights(max_ene), + & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp common /potentials/ potname(5) character*3 potname diff --git a/source/wham/src/include_unres/COMMON.SCCOR b/source/wham/src/include_unres/COMMON.SCCOR index efe2f80..28d748a 100644 --- a/source/wham/src/include_unres/COMMON.SCCOR +++ b/source/wham/src/include_unres/COMMON.SCCOR @@ -4,17 +4,15 @@ cc Parameters of the SCCOR term & dcostau,dsintau,dtauangle,dcosomicron, & domicron,v0sccor integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor - common /sccor/ v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), - & v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), - & v0sccor(maxterm_sccor,-ntyp:ntyp), - & vlor1sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), - & vlor2sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), - & vlor3sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), - & gloc_sc(3,0:maxres2,10), + common /sccor/ v1sccor(maxterm_sccor,3,20,20), + & v2sccor(maxterm_sccor,3,20,20), + & v0sccor(ntyp,ntyp), + & vlor1sccor(maxterm_sccor,20,20), + & vlor2sccor(maxterm_sccor,20,20), + & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10), & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), & domicron(3,3,3,maxres2), - & nterm_sccor(-ntyp:ntyp,-ntyp:ntyp),isccortyp(-ntyp:ntyp), - & nsccortyp, - & nlor_sccor(-ntyp:ntyp,-ntyp:ntyp) + & nterm_sccor(ntyp,ntyp),isccortyp(ntyp),nsccortyp, + & nlor_sccor(ntyp,ntyp) diff --git a/source/wham/src/include_unres/COMMON.VAR b/source/wham/src/include_unres/COMMON.VAR deleted file mode 100644 index d560c87..0000000 --- a/source/wham/src/include_unres/COMMON.VAR +++ /dev/null @@ -1,21 +0,0 @@ -C Store the geometric variables in the following COMMON block. - integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar, - & mask_theta,mask_phi,mask_side - double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, - & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, - & xxtab,yytab,zztab,xxref,yyref,zzref - common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & omicron(2,maxres),tauangle(3,maxres), - & vbld(2*maxres),thetaref(maxres),phiref(maxres), - & costtab(maxres), sinttab(maxres), cost2tab(maxres), - & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar -C Store the angles and variables corresponding to old conformations (for use -C in MCM). - common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave), - & Origin(maxsave),nstore -C freeze some variables - logical mask_r - common /restr/ varall(maxvar),mask_r,mask_theta(maxres), - & mask_phi(maxres),mask_side(maxres) diff --git a/source/wham/src/initialize_p.F b/source/wham/src/initialize_p.F index bd617ee..6562302 100644 --- a/source/wham/src/initialize_p.F +++ b/source/wham/src/initialize_p.F @@ -228,21 +228,20 @@ c------------------------------------------------------------------------- &'C','M','F','I','L','V','W','Y','A','G','T', &'S','Q','N','E','D','H','R','K','P','X'/ data potname /'LJ','LJK','BP','GB','GBV'/ - data ename / + data ename / & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", - & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP", - & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T"/ + & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ", + & "ESTR ","EVDW2_14 ","ESCCOR ", " ","EDIHCNSTR","EHOMOLOGY", + & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/ data wname / & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC"/ - data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0, - & 1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,1.0d0, - & 0.0d0,0.0/ - data nprint_ene /21/ - data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19, - & 16,15,17,20,21/ + & "WSTRAIN","WVDWPP","WBOND","SCAL14","WSCCOR"," ","WDIHCNSTR", + & "WHOMOLOGY","WDFAD","WDFAT","WDFAN","WDFAB"/ + data nprint_ene /24/ + data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16, + & 21,23,24,25,26,0,0,0/ end c--------------------------------------------------------------------------- subroutine init_int_table @@ -576,3 +575,46 @@ cd & ' nhpb',nhpb,' link_start=',link_start, cd & ' link_end',link_end return end +c------------------------------------------------------------------------------ + subroutine homology_partition + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SBRIDGE' + include 'COMMON.IOUNITS' +c include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.HOMRESTR' + write(iout,*)"homology_partition: lim_odl=",lim_odl, + & " lim_dih",lim_dih +#ifdef MPL + call int_bounds(lim_odl,link_start_homo,link_end_homo) + call int_bounds(lim_dih-nnt+1,idihconstr_start_homo, + & idihconstr_end_homo) + idihconstr_start_homo=idihconstr_start_homo+nnt-1 + idihconstr_end_homo=idihconstr_end_homo+nnt-1 + if (me.eq.king .or. .not. out1file) + & write (iout,*) 'Processor',fg_rank,' CG group',kolor, + & ' absolute rank',MyRank, + & ' lim_odl',lim_odl,' link_start=',link_start_homo, + & ' link_end',link_end_homo,' lim_dih',lim_dih, + & ' idihconstr_start_homo',idihconstr_start_homo, + & ' idihconstr_end_homo',idihconstr_end_homo +#else + link_start_homo=1 + link_end_homo=lim_odl + idihconstr_start_homo=nnt + idihconstr_end_homo=lim_dih + write (iout,*) + & ' lim_odl',lim_odl,' link_start=',link_start_homo, + & ' link_end',link_end_homo,' lim_dih',lim_dih, + & ' idihconstr_start_homo',idihconstr_start_homo, + & ' idihconstr_end_homo',idihconstr_end_homo +#endif + return + end diff --git a/source/wham/src/make_ensemble1.F b/source/wham/src/make_ensemble1.F index e9c0754..71d65db 100644 --- a/source/wham/src/make_ensemble1.F +++ b/source/wham/src/make_ensemble1.F @@ -23,7 +23,7 @@ double precision fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl, & eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/ double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, - & escloc, + & escloc,ehomology_constr, & ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,tt integer i,ii,ik,iproc,iscor,j,k,l,ib,iparm,iprot,nlist @@ -162,6 +162,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft estr=enetb(18,i,iparm) esccor=enetb(19,i,iparm) edihcnstr=enetb(20,i,iparm) + ehomology_constr=enetb(22,i,iparm) #ifdef SPLITELE etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 @@ -171,7 +172,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr #else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) @@ -181,7 +182,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr #endif #ifdef MPI Fdimless(i)= diff --git a/source/wham/src/molread_zs.F b/source/wham/src/molread_zs.F index 6e0727f..b12fcfd 100644 --- a/source/wham/src/molread_zs.F +++ b/source/wham/src/molread_zs.F @@ -8,6 +8,7 @@ C include 'COMMON.IOUNITS' include 'COMMON.GEO' include 'COMMON.VAR' +c include 'include_unres/COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.LOCAL' include 'COMMON.NAMES' @@ -27,6 +28,13 @@ C call reada(controlcard,'SCALSCP',scalscp,1.0d0) call reada(controlcard,'CUTOFF',cutoff_corr,7.0d0) call reada(controlcard,'DELT_CORR',delt_corr,0.5d0) +C Bartek + call reada(controlcard,'WDFAD',wdfa_dist,0.0d0) + call reada(controlcard,'WDFAT',wdfa_tor,0.0d0) + call reada(controlcard,'WDFAN',wdfa_nei,0.0d0) + call reada(controlcard,'WDFAB',wdfa_beta,0.0d0) + write (iout,*) "wdfa_dist",wdfa_dist," wdfa_tor",wdfa_tor, + & " wdfa_nei",wdfa_nei," wdfa_beta",wdfa_beta r0_corr=cutoff_corr-delt_corr call readi(controlcard,"NRES",nres,0) iscode=index(controlcard,"ONE_LETTER") @@ -94,6 +102,25 @@ C Convert sequence to numeric code if (itype(1).eq.21) nnt=2 if (itype(nres).eq.21) nct=nct-1 write(iout,*) 'NNT=',NNT,' NCT=',NCT + +C Juyong:READ init_vars +C Initialize variables! +C Juyong:READ read_info +C READ fragment information!! +C both routines should be in dfa.F file!! + + if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. + & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then + write (iout,*) "Calling init_dfa_vars" + call flush(iout) + call init_dfa_vars + write (iout,*) 'init_dfa_vars finished!' + call flush(iout) + call read_dfa_info + write (iout,*) 'read_dfa_info finished!' + call flush(iout) + endif + c Read distance restraints if (constr_dist.gt.0) then if (refstr) call read_ref_structure(*11) @@ -101,6 +128,58 @@ c Read distance restraints call hpb_partition endif + if (constr_homology.gt.0) then +c write (iout,*) "About to call read_constr_homology" +c call flush(iout) + call read_constr_homology +c write (iout,*) "Exit read_constr_homology" +c call flush(iout) + if (indpdb.gt.0 .or. pdbref) then + do i=1,2*nres + do j=1,3 + c(j,i)=crefjlee(j,i) + cref(j,i)=crefjlee(j,i) + enddo + enddo + endif +#ifdef DEBUG + write (iout,*) "Array C" + do i=1,nres + write (iout,'(i5,3f8.3,5x,3f8.3)') i,(c(j,i),j=1,3), + & (c(j,i+nres),j=1,3) + enddo + write (iout,*) "Array Cref" + do i=1,nres + write (iout,'(i5,3f8.3,5x,3f8.3)') i,(cref(j,i),j=1,3), + & (cref(j,i+nres),j=1,3) + enddo +#endif +#ifdef DEBUG + call int_from_cart1(.false.) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) + write (iout,*) i," phiref",phiref(i)," thetaref",thetaref(i) + enddo + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo + enddo +#endif + else + homol_nset=0 + endif + + call setup_var call init_int_table if (ns.gt.0) then @@ -273,6 +352,7 @@ c------------------------------------------------------------------------------- subroutine read_dist_constr implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' @@ -395,3 +475,382 @@ c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) call flush(iout) return end + + + +c====------------------------------------------------------------------- + subroutine read_constr_homology + + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.INTERACT' + include 'COMMON.HOMRESTR' +c +c For new homol impl +c + include 'COMMON.VAR' +c include 'include_unres/COMMON.VAR' +c + +c double precision odl_temp,sigma_odl_temp,waga_theta,waga_d, +c & dist_cut +c common /przechowalnia/ odl_temp(maxres,maxres,max_template), +c & sigma_odl_temp(maxres,maxres,max_template) + character*2 kic2 + character*24 model_ki_dist, model_ki_angle + character*500 controlcard + integer ki, i, j, k, l + logical lprn /.true./ +c +c FP - Nov. 2014 Temporary specifications for new vars +c + double precision rescore_tmp,x12,y12,z12 + double precision, dimension (max_template,maxres) :: rescore + character*24 tpl_k_rescore +c ----------------------------------------------------------------- +c Reading multiple PDB ref structures and calculation of retraints +c not using pre-computed ones stored in files model_ki_{dist,angle} +c FP (Nov., 2014) +c ----------------------------------------------------------------- +c +c +c Alternative: reading from input + call card_concat(controlcard,.true.) + call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0) + call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0) + call reada(controlcard,"HOMOL_THETA",waga_theta,1.0d0) ! new + call reada(controlcard,"HOMOL_SCD",waga_d,1.0d0) ! new + call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) ! for diff ways of calc sigma + + call readi(controlcard,"HOMOL_NSET",homol_nset,1) + if (homol_nset.gt.1)then + call card_concat(controlcard,.true.) + read(controlcard,*) (waga_homology(i),i=1,homol_nset) + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) "iset homology_weight " +c do i=1,homol_nset +c write(iout,*) i,waga_homology(i) +c enddo + endif + iset=mod(kolor,homol_nset)+1 + else + iset=1 + waga_homology(1)=1.0 + endif +c write(iout,*) "waga_homology(",iset,")",waga_homology(iset) + +cd write (iout,*) "nnt",nnt," nct",nct +cd call flush(iout) + + + lim_odl=0 + lim_dih=0 +c +c New +c + lim_theta=0 + lim_xx=0 +c +c Reading HM global scores (prob not required) +c +c open (4,file="HMscore") +c do k=1,constr_homology +c read (4,*,end=521) hmscore_tmp +c hmscore(k)=hmscore_tmp ! Another transformation can be used +c write(*,*) "Model", k, ":", hmscore(k) +c enddo +c521 continue + +c write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d + + do k=1,constr_homology + + read(inp,'(a)') pdbfile +c Next stament causes error upon compilation (?) +c if(me.eq.king.or. .not. out1file) +c write (iout,'(2a)') 'PDB data will be read from file ', +c & pdbfile(:ilen(pdbfile)) + open(ipdbin,file=pdbfile,status='old',err=33) + goto 34 + 33 write (iout,'(a)') 'Error opening PDB file.' + stop + 34 continue +c print *,'Begin reading pdb data' +c +c Files containing res sim or local scores (former containing sigmas) +c + + write(kic2,'(bz,i2.2)') k + + tpl_k_rescore="template"//kic2//".sco" +c tpl_k_sigma_odl="template"//kic2//".sigma_odl" +c tpl_k_sigma_dih="template"//kic2//".sigma_dih" +c tpl_k_sigma_theta="template"//kic2//".sigma_theta" +c tpl_k_sigma_d="template"//kic2//".sigma_d" + + unres_pdb=.false. + call readpdb + do i=1,2*nres + do j=1,3 + crefjlee(j,i)=c(j,i) + enddo + enddo +#ifdef DEBUG + do i=1,nres + write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3), + & (crefjlee(j,i+nres),j=1,3) + enddo +#endif + write (iout,*) "read_constr_homology: after reading pdb file" + call flush(iout) + +c +c Distance restraints +c +c ... --> odl(k,ii) +C Copy the coordinates from reference coordinates (?) + do i=1,2*nres + do j=1,3 + c(j,i)=cref(j,i) +c write (iout,*) "c(",j,i,") =",c(j,i) + enddo + enddo +c +c From read_dist_constr (commented out 25/11/2014 <-> res sim) +c +c write(iout,*) "tpl_k_rescore - ",tpl_k_rescore + open (ientin,file=tpl_k_rescore,status='old') + do irec=1,maxdim ! loop for reading res sim + if (irec.eq.1) then + rescore(k,irec)=0.0d0 + goto 1301 + endif + read (ientin,*,end=1401) rescore_tmp +c rescore(k,irec)=rescore_tmp+1.0d0 ! to avoid 0 values + rescore(k,irec)=0.5d0*(rescore_tmp+0.5d0) ! alt transf to reduce scores +c write(iout,*) "rescore(",k,irec,") =",rescore(k,irec) + 1301 continue + enddo + 1401 continue + close (ientin) +c open (ientin,file=tpl_k_sigma_odl,status='old') +c do irec=1,maxdim ! loop for reading sigma_odl +c read (ientin,*,end=1401) i, j, +c & sigma_odl_temp(i+nnt-1,j+nnt-1,k) ! new variable (?) +c sigma_odl_temp(j+nnt-1,i+nnt-1,k)= ! which purpose? +c & sigma_odl_temp(i+nnt-1,j+nnt-1,k) +c enddo +c 1401 continue +c close (ientin) + if (waga_dist.ne.0.0d0) then + ii=0 + do i = nnt,nct-2 ! right? without parallel. + do j=i+2,nct ! right? +c do i = 1,nres ! alternative for bounds as used to set initial values in orig. read_constr_homology +c do j=i+2,nres ! ibid +c do i = nnt,nct-2 ! alternative for bounds as used to assign dist restraints in orig. read_constr_homology (s. above) +c do j=i+2,nct ! ibid + ii=ii+1 +c write (iout,*) "k",k +c write (iout,*) "i",i," j",j," constr_homology", +c & constr_homology + ires_homo(ii)=i + jres_homo(ii)=j +c +c Attempt to replace dist(i,j) by its definition in ... +c + x12=c(1,i)-c(1,j) + y12=c(2,i)-c(2,j) + z12=c(3,i)-c(3,j) + distal=dsqrt(x12*x12+y12*y12+z12*z12) + odl(k,ii)=distal +c +c odl(k,ii)=dist(i,j) +c write (iout,*) "dist(",i,j,") =",dist(i,j) +c write (iout,*) "distal = ",distal +c write (iout,*) "odl(",k,ii,") =",odl(k,ii) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,j,") =",rescore(k,j) +c +c Calculation of sigma from res sim +c +c if (odl(k,ii).le.6.0d0) then +c sigma_odl(k,ii)=hmscore(k)*rescore(k,i)*rescore(k,j) +c Other functional forms possible depending on odl(k,ii), eg. +c + if (odl(k,ii).le.dist_cut) then + sigma_odl(k,ii)=rescore(k,i)+rescore(k,j) ! other exprs possible +c sigma_odl(k,ii)=hmscore(k)*rescore(k,i)*rescore(k,j) + else + sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* ! sigma ~ rescore ~ error + & dexp(0.5d0*(odl(k,ii)/dist_cut)**2) + +c Following expr replaced by a positive exp argument +c sigma_odl(k,ii)=(rescore(k,i)+rescore(k,j))* +c & dexp(-0.5d0*(odl(k,ii)/dist_cut)**2) + +c sigma_odl(k,ii)=hmscore(k)*rescore(k,i)*rescore(k,j)* +c & dexp(-0.5d0*(odl(k,ii)/dist_cut)**2) + endif +c + sigma_odl(k,ii)=1.0d0/(sigma_odl(k,ii)*sigma_odl(k,ii)) ! rescore ~ error +c sigma_odl(k,ii)=sigma_odl(k,ii)*sigma_odl(k,ii) +c +c sigma_odl(k,ii)=sigma_odl_temp(i,j,k)* ! new var read from file (?) +c & sigma_odl_temp(i,j,k) ! not inverse because of use of res. similarity + enddo +c read (ientin,*) sigma_odl(k,ii) ! 1st variant + enddo +c lim_odl=ii +c if (constr_homology.gt.0) call homology_partition + endif +c +c Theta, dihedral and SC retraints +c + if (waga_angle.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_dih,status='old') +c do irec=1,maxres-3 ! loop for reading sigma_dih +c read (ientin,*,end=1402) i,j,ki,l,sigma_dih(k,i+nnt-1) ! j,ki,l what for? +c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! right? +c sigma_dih(k,i+nnt-1)=sigma_dih(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_dih(k,i+nnt-1) +c enddo +c1402 continue +c close (ientin) + do i = nnt+3,nct ! right? without parallel. +c do i=1,nres ! alternative for bounds acc to readpdb? +c do i=1,nres-3 ! alternative for bounds as used to set initial values in orig. read_constr_homology +c do i=idihconstr_start_homo,idihconstr_end_homo ! with FG parallel. + dih(k,i)=phiref(i) ! right? +c read (ientin,*) sigma_dih(k,i) ! original variant +c write (iout,*) "dih(",k,i,") =",dih(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2), +c & "rescore(",k,i-3,") =",rescore(k,i-3) + + sigma_dih(k,i)=rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2)+rescore(k,i-3) ! right expression ? +c +c write (iout,*) "Raw sigmas for dihedral angle restraints" +c write (iout,'(i5,10(2f8.2,4x))') i,sigma_dih(k,i) +c sigma_dih(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2)*rescore(k,i-3) ! right expression ? +c Instead of res sim other local measure of b/b str reliability possible + sigma_dih(k,i)=1.0d0/(sigma_dih(k,i)*sigma_dih(k,i)) +c sigma_dih(k,i)=sigma_dih(k,i)*sigma_dih(k,i) + if (i-nnt-2.gt.lim_dih) lim_dih=i-nnt-2 ! right? +c if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 ! original when readin i from file + enddo + endif + + if (waga_theta.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_theta,status='old') +c do irec=1,maxres-2 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1403) i,j,ki,sigma_theta(k,i+nnt-1) ! j,ki what for? +c sigma_theta(k,i+nnt-1)=sigma_theta(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_theta(k,i+nnt-1) +c enddo +c1403 continue +c close (ientin) + + do i = nnt+2,nct ! right? without parallel. +c do i = i=1,nres ! alternative for bounds acc to readpdb? +c do i=ithet_start,ithet_end ! with FG parallel. + thetatpl(k,i)=thetaref(i) +c write (iout,*) "thetatpl(",k,i,") =",thetatpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i), +c & "rescore(",k,i-1,") =",rescore(k,i-1), +c & "rescore(",k,i-2,") =",rescore(k,i-2) +c read (ientin,*) sigma_theta(k,i) ! 1st variant + sigma_theta(k,i)=rescore(k,i)+rescore(k,i-1)+ + & rescore(k,i-2) ! right expression ? + sigma_theta(k,i)=1.0d0/(sigma_theta(k,i)*sigma_theta(k,i)) + +c sigma_theta(k,i)=hmscore(k)*rescore(k,i)*rescore(k,i-1)* +c rescore(k,i-2) ! right expression ? +c sigma_theta(k,i)=sigma_theta(k,i)*sigma_theta(k,i) + if (i-nnt-1.gt.lim_theta) lim_theta=i-nnt-1 ! right? + enddo + endif + + if (waga_d.gt.0.0d0) then +c open (ientin,file=tpl_k_sigma_d,status='old') +c do irec=1,maxres-1 ! loop for reading sigma_theta, right bounds? +c read (ientin,*,end=1404) i,j,sigma_d(k,i+nnt-1) ! j,ki what for? +c sigma_d(k,i+nnt-1)=sigma_d(k,i+nnt-1)* ! not inverse because of use of res. similarity +c & sigma_d(k,i+nnt-1) +c enddo +c1404 continue + close (ientin) + + do i = nnt,nct ! right? without parallel. +c do i=2,nres-1 ! alternative for bounds acc to readpdb? +c do i=loc_start,loc_end ! with FG parallel. + if (itype(i).eq.10) goto 1 ! right? + xxtpl(k,i)=xxref(i) + yytpl(k,i)=yyref(i) + zztpl(k,i)=zzref(i) +c write (iout,*) "xxtpl(",k,i,") =",xxtpl(k,i) +c write (iout,*) "yytpl(",k,i,") =",yytpl(k,i) +c write (iout,*) "zztpl(",k,i,") =",zztpl(k,i) +c write(iout,*) "rescore(",k,i,") =",rescore(k,i) + sigma_d(k,i)=rescore(k,i) ! right expression ? + sigma_d(k,i)=1.0d0/(sigma_d(k,i)*sigma_d(k,i)) + +c sigma_d(k,i)=hmscore(k)*rescore(k,i) ! right expression ? +c sigma_d(k,i)=sigma_d(k,i)*sigma_d(k,i) +c read (ientin,*) sigma_d(k,i) ! 1st variant + if (i-nnt+1.gt.lim_xx) lim_xx=i-nnt+1 ! right? + 1 continue + enddo + endif + close(ientin) + enddo + if (waga_dist.ne.0.0d0) lim_odl=ii + if (constr_homology.gt.0) call homology_partition + if (constr_homology.gt.0) call init_int_table +cd write (iout,*) "homology_partition: lim_theta= ",lim_theta, +cd & "lim_xx=",lim_xx +c write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +c write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +c +c Print restraints +c + if (.not.lprn) return +cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d + if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write (iout,*) "Distance restraints from templates" + do ii=1,lim_odl + write(iout,'(3i5,10(2f16.2,4x))') ii,ires_homo(ii),jres_homo(ii), + & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),ki=1,constr_homology) + enddo + write (iout,*) "Dihedral angle restraints from templates" + do i=nnt+3,lim_dih + write (iout,'(i5,10(2f8.2,4x))') i,(rad2deg*dih(ki,i), + & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "Virtual-bond angle restraints from templates" + do i=nnt+2,lim_theta + write (iout,'(i5,10(2f8.2,4x))') i,(rad2deg*thetatpl(ki,i), + & rad2deg/dsqrt(sigma_theta(ki,i)),ki=1,constr_homology) + enddo + write (iout,*) "SC restraints from templates" + do i=nnt,lim_xx + write(iout,'(i5,10(4f8.2,4x))') i, + & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i), + & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology) + enddo + endif +c ----------------------------------------------------------------- + return + end +c---------------------------------------------------------------------- diff --git a/source/wham/src/parmread.F b/source/wham/src/parmread.F index 435ee09..b0bde79 100644 --- a/source/wham/src/parmread.F +++ b/source/wham/src/parmread.F @@ -99,6 +99,12 @@ c wstrain=ww(15) wbond=ww(18) wsccor=ww(19) + wdfa_dist=ww(23) + wdfa_tor=ww(24) + wdfa_nei=ww(25) + wdfa_beta=ww(26) + write (iout,*) "wdfa_dist",wdfa_dist," wdfa_tor",wdfa_tor, + & " wdfa_nei",wdfa_nei," wdfa_beta",wdfa_beta endif cc write(iout,*) "KURWA", wstrain,akcm,akth,wsc,dyn_ss diff --git a/source/wham/src/promienie.f b/source/wham/src/promienie.f index 12a2e80..66016fd 100644 --- a/source/wham/src/promienie.f +++ b/source/wham/src/promienie.f @@ -1,6 +1,7 @@ subroutine promienie(*) implicit none include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' include 'COMMON.CONTROL' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' diff --git a/source/wham/src/readpdb.F b/source/wham/src/readpdb.F new file mode 100644 index 0000000..6261f50 --- /dev/null +++ b/source/wham/src/readpdb.F @@ -0,0 +1,513 @@ + subroutine readpdb +C Read the PDB file and convert the peptide geometry into virtual-chain +C geometry. + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.FRAG' + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.CONTROL' +c include 'COMMON.DISTFIT' + include 'COMMON.SETUP' + integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity +c & ishift_pdb + logical lprn /.false./,fail + double precision e1(3),e2(3),e3(3) + double precision dcj,efree_temp + character*3 seq,res + character*5 atom + character*80 card + double precision sccor(3,20) + integer rescode + efree_temp=0.0d0 + ibeg=1 + ishift1=0 + ishift=0 +c write (2,*) "UNRES_PDB",unres_pdb + ires=0 + ires_old=0 + iii=0 + lsecondary=.false. + nhfrag=0 + nbfrag=0 + do i=1,10000 + read (ipdbin,'(a80)',end=10) card +c 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) + endif + if (card(:5).eq.'SHEET') then + nbfrag=nbfrag+1 + lsecondary=.true. + read(card(24:26),*) bfrag(1,nbfrag) + read(card(35:37),*) bfrag(2,nbfrag) +crc---------------------------------------- +crc to be corrected !!! + bfrag(3,nbfrag)=bfrag(1,nbfrag) + bfrag(4,nbfrag)=bfrag(2,nbfrag) +crc---------------------------------------- + endif + if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 +c Read free energy + if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp +C Fish out the ATOM cards. + if (index(card(1:4),'ATOM').gt.0) then + read (card(12:16),*) atom +c write (iout,*) "! ",atom," !",ires +c if (atom.eq.'CA' .or. atom.eq.'CH3') then + read (card(23:26),*) ires + read (card(18:20),'(a3)') res +c write (iout,*) "ires",ires,ires-ishift+ishift1, +c & " ires_old",ires_old +c write (iout,*) "ishift",ishift," ishift1",ishift1 +c write (iout,*) "IRES",ires-ishift+ishift1,ires_old + if (ires-ishift+ishift1.ne.ires_old) then +C Calculate the CM of the preceding residue. +c if (ibeg.eq.0) call sccenter(ires,iii,sccor) + if (ibeg.eq.0) then +c write (iout,*) "Calculating sidechain center iii",iii +c if (unres_pdb) then +c do j=1,3 +c dc(j,ires)=sccor(j,iii) +c enddo +c else + call sccenter(ires_old,iii,sccor) +c endif + iii=0 + endif +C Start new residue. + if (res.eq.'Cl-' .or. res.eq.'Na+') then + ires=ires_old + cycle + else if (ibeg.eq.1) then +c write (iout,*) "BEG ires",ires + ishift=ires-1 + if (res.ne.'GLY' .and. res.ne. 'ACE') then + ishift=ishift-1 + itype(1)=21 + endif + ires=ires-ishift+ishift1 + ires_old=ires +c write (iout,*) "ishift",ishift," ires",ires, +c & " ires_old",ires_old + ibeg=0 + else + ishift=ishift-(ires-ishift+ishift1-ires_old-1) + ires=ires-ishift+ishift1 + ires_old=ires + endif + if (res.eq.'ACE' .or. res.eq.'NHE') then + itype(ires)=10 + else + itype(ires)=rescode(ires,res,0) + endif + else + ires=ires-ishift+ishift1 + endif +c write (iout,*) "ires_old",ires_old," ires",ires + if (card(27:27).eq."A" .or. card(27:27).eq."B") then +c ishift1=ishift1+1 + endif +c write (2,*) "ires",ires," res ",res," ity",ity + if (atom.eq.'CA' .or. atom.eq.'CH3' .or. + & res.eq.'NHE'.and.atom(:2).eq.'HN') then + read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) +c write (iout,*) "backbone ",atom +#ifdef DEBUG + write (iout,'(2i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) +#endif + iii=iii+1 + do j=1,3 + sccor(j,iii)=c(j,ires) + enddo + if (ishift.ne.0) then + ires_ca=ires+ishift-ishift1 + else + ires_ca=ires + endif +c write (*,*) card(23:27),ires,itype(ires) + else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. + & atom.ne.'N' .and. atom.ne.'C' .and. + & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. + & atom.ne.'OXT' .and. atom(:2).ne.'3H') then +c write (iout,*) "sidechain ",atom + iii=iii+1 + read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) + endif + endif + enddo + 10 continue +#ifdef DEBUG + write (iout,'(a,i5)') ' Number of residues found: ',ires +#endif + if (ires.eq.0) return +C Calculate the CM of the last side chain. + if (iii.gt.0) then +c if (unres_pdb) then +c do j=1,3 +c dc(j,ires)=sccor(j,iii) +c enddo +c else + call sccenter(ires,iii,sccor) +c endif + endif + nres=ires + nsup=nres + nstart_sup=1 + if (itype(nres).ne.10) then + nres=nres+1 + itype(nres)=21 + do j=1,3 + dcj=c(j,nres-2)-c(j,nres-3) + c(j,nres)=c(j,nres-1)+dcj + c(j,2*nres)=c(j,nres) + enddo + endif + do i=2,nres-1 + do j=1,3 + c(j,i+nres)=dc(j,i) + enddo + enddo + do j=1,3 + c(j,nres+1)=c(j,1) + c(j,2*nres)=c(j,nres) + enddo + if (itype(1).eq.21) then + nsup=nsup-1 + nstart_sup=2 +c if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue +c call refsys(2,3,4,e1,e2,e3,fail) +c if (fail) then +c e2(1)=0.0d0 +c e2(2)=1.0d0 +c e2(3)=0.0d0 +c endif +c do j=1,3 +c c(j,1)=c(j,2)-3.8d0*e2(j) +c enddo +c else + do j=1,3 + dcj=c(j,4)-c(j,3) + c(j,1)=c(j,2)-dcj + c(j,nres+1)=c(j,1) + enddo +c endif + endif +C Copy the coordinates to reference coordinates +c do i=1,2*nres +c do j=1,3 +c cref(j,i)=c(j,i) +c enddo +c enddo +C Calculate internal coordinates. + if (lprn) then + write (iout,'(/a)') + & "Cartesian coordinates of the reference structure" + write (iout,'(a,3(3x,a5),5x,3(3x,a5))') + & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" + do ires=1,nres + write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') + & restyp(itype(ires)),ires,(c(j,ires),j=1,3), + & (c(j,ires+nres),j=1,3) + enddo + endif +C Calculate internal coordinates. + if(me.eq.king.or..not.out1file)then + write (iout,'(a)') + & "Backbone and SC coordinates as read from the PDB" + do ires=1,nres + write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') + & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), + & (c(j,nres+ires),j=1,3) + enddo + endif + call int_from_cart1(.false.) + call int_from_cart(.true.,.false.) + call sc_loc_geom(.false.) + do i=1,nres + thetaref(i)=theta(i) + phiref(i)=phi(i) +c + phi_ref(i)=phi(i) + theta_ref(i)=theta(i) + alph_ref(i)=alph(i) + omeg_ref(i)=omeg(i) + enddo +c +#ifdef DEBUG + do i=1,nres-1 + do j=1,3 + dc(j,i)=c(j,i+1)-c(j,i) + dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) + enddo + enddo + do i=2,nres-1 + do j=1,3 + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) + enddo +c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), +c & vbld_inv(i+nres) + enddo +#endif +c call chainbuild +C Copy the coordinates to reference coordinates + do i=1,2*nres + do j=1,3 + cref(j,i)=c(j,i) + enddo + enddo + + + do j=1,nbfrag + do i=1,4 + bfrag(i,j)=bfrag(i,j)-ishift + enddo + enddo + + do j=1,nhfrag + do i=1,2 + hfrag(i,j)=hfrag(i,j)-ishift + enddo + enddo + ishift_pdb=ishift + return + end +c--------------------------------------------------------------------------- + subroutine int_from_cart(lside,lprn) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + include "mpif.h" +#endif + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.CONTROL' + include 'COMMON.SETUP' + character*3 seq,atom,res +c character*5 atom + character*80 card + double precision sccor(3,20) +c dimension sccor(3,20) + integer rescode + logical lside,lprn + double precision dist,alpha,beta,di + if(me.eq.king.or..not.out1file)then + if (lprn) then + write (iout,'(/a)') + & 'Internal coordinates calculated from crystal structure.' + if (lside) then + write (iout,'(8a)') ' Res ',' dvb',' Theta', + & ' Gamma',' Dsc_id',' Dsc',' Alpha', + & ' Beta ' + else + write (iout,'(4a)') ' Res ',' dvb',' Theta', + & ' Gamma' + endif + endif + endif + do i=1,nres-1 + iti=itype(i) + if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then + write (iout,'(a,i4)') 'Bad Cartesians for residue',i +ctest stop + endif + vbld(i+1)=dist(i,i+1) + vbld_inv(i+1)=1.0d0/vbld(i+1) + if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) + if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) + enddo +c if (unres_pdb) then +c if (itype(1).eq.21) then +c theta(3)=90.0d0*deg2rad +c phi(4)=180.0d0*deg2rad +c vbld(2)=3.8d0 +c vbld_inv(2)=1.0d0/vbld(2) +c endif +c if (itype(nres).eq.21) then +c theta(nres)=90.0d0*deg2rad +c phi(nres)=180.0d0*deg2rad +c vbld(nres)=3.8d0 +c vbld_inv(nres)=1.0d0/vbld(2) +c endif +c endif + if (lside) then + do i=2,nres-1 + do j=1,3 + c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) + & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) + enddo + iti=itype(i) + di=dist(i,nres+i) +C 10/03/12 Adam: Correction for zero SC-SC bond length + if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) + & di=dsc(itype(i)) + vbld(i+nres)=di + if (itype(i).ne.10) then + vbld_inv(i+nres)=1.0d0/di + else + vbld_inv(i+nres)=0.0d0 + endif + if (iti.ne.10) then + alph(i)=alpha(nres+i,i,maxres2) + omeg(i)=beta(nres+i,i,maxres2,i+1) + endif + if(me.eq.king.or..not.out1file)then + if (lprn) + & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), + & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), + & rad2deg*alph(i),rad2deg*omeg(i) + endif + enddo + else if (lprn) then + do i=2,nres + iti=itype(i) + if(me.eq.king.or..not.out1file) + & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), + & rad2deg*theta(i),rad2deg*phi(i) + enddo + endif + return + end +c------------------------------------------------------------------------------- + subroutine sc_loc_geom(lprn) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + include "mpif.h" +#endif + include 'COMMON.LOCAL' + include 'COMMON.VAR' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.NAMES' + include 'COMMON.CONTROL' + include 'COMMON.SETUP' + double precision x_prime(3),y_prime(3),z_prime(3) + logical lprn + do i=1,nres-1 + do j=1,3 + dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) + enddo + enddo + do i=2,nres-1 + if (itype(i).ne.10) then + do j=1,3 + dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) + enddo + else + do j=1,3 + dc_norm(j,i+nres)=0.0d0 + enddo + endif + enddo + do i=2,nres-1 + costtab(i+1) =dcos(theta(i+1)) + sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) + cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) + sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) + cosfac2=0.5d0/(1.0d0+costtab(i+1)) + cosfac=dsqrt(cosfac2) + sinfac2=0.5d0/(1.0d0-costtab(i+1)) + sinfac=dsqrt(sinfac2) + it=itype(i) + if (it.ne.10) then +c +C Compute the axes of tghe local cartesian coordinates system; store in +c x_prime, y_prime and z_prime +c + do j=1,3 + x_prime(j) = 0.00 + y_prime(j) = 0.00 + z_prime(j) = 0.00 + enddo + do j = 1,3 + x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac + y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac + enddo + call vecpr(x_prime,y_prime,z_prime) +c +C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), +C to local coordinate system. Store in xx, yy, zz. +c + xx=0.0d0 + yy=0.0d0 + zz=0.0d0 + do j = 1,3 + xx = xx + x_prime(j)*dc_norm(j,i+nres) + yy = yy + y_prime(j)*dc_norm(j,i+nres) + zz = zz + z_prime(j)*dc_norm(j,i+nres) + enddo + + xxref(i)=xx + yyref(i)=yy + zzref(i)=zz + else + xxref(i)=0.0d0 + yyref(i)=0.0d0 + zzref(i)=0.0d0 + endif + enddo + if (lprn) then + do i=2,nres + iti=itype(i) + if(me.eq.king.or..not.out1file) + & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), + & yyref(i),zzref(i) + enddo + endif + return + end +c--------------------------------------------------------------------------- + subroutine sccenter(ires,nscat,sccor) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + dimension sccor(3,20) + do j=1,3 + sccmj=0.0D0 + do i=1,nscat + sccmj=sccmj+sccor(j,i) + enddo + dc(j,ires)=sccmj/nscat + enddo + return + end +c--------------------------------------------------------------------------- + subroutine bond_regular + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CALC' + include 'COMMON.INTERACT' + include 'COMMON.CHAIN' + do i=1,nres-1 + vbld(i+1)=vbl + vbld_inv(i+1)=1.0d0/vbld(i+1) + vbld(i+1+nres)=dsc(itype(i+1)) + vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) +c print *,vbld(i+1),vbld(i+1+nres) + enddo + return + end diff --git a/source/wham/src/readpdb.f b/source/wham/src/readpdb.f deleted file mode 100644 index 0b82476..0000000 --- a/source/wham/src/readpdb.f +++ /dev/null @@ -1,219 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit none - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - character*3 seq,atom,res - character*80 card - double precision sccor(3,20) - integer i,j,iii,ibeg,ishift,ishift1,ity,ires,ires_old - double precision dcj - integer rescode - ibeg=1 - ishift1=0 - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) call sccenter(ires,iii,sccor) -C Start new residue. - ires_old=ires+ishift-ishift1 - read (card(23:26),*) ires -c print *,"ires_old",ires_old," ires",ires - if (card(27:27).eq."A" .or. card(27:27).eq."B") then -c ishift1=ishift1+1 - endif - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - else - ishift=ishift+ires-ires_old-1 - endif - ires=ires-ishift+ishift1 - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) - write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo -c write (*,*) card(23:27),ires,itype(ires) - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - call sccenter(ires,iii,sccor) - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo -C Calculate internal coordinates. - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,ires+nres),j=1,3) - enddo - call flush(iout) - call int_from_cart(.true.,.true.) - do i=1,nres - phi_ref(i)=phi(i) - theta_ref(i)=theta(i) - alph_ref(i)=alph(i) - omeg_ref(i)=omeg(i) - enddo - ishift_pdb=ishift - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit none - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - character*3 seq,atom,res - character*80 card - double precision sccor(3,20) - integer rescode - double precision dist,alpha,beta,di - integer i,j,iti - logical lside,lprn - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Phi',' Dsc_id',' Dsc',' Alpha', - & ' Omega' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Phi' - endif - endif - do i=2,nres - iti=itype(i) - write (iout,*) i,i-1,(c(j,i),j=1,3),(c(j,i-1),j=1,3),dist(i,i-1) - if (itype(i-1).ne.21 .and. itype(i).ne.21 .and. - & (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0)) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i - stop - endif - theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo - if (itype(1).eq.21) then - do j=1,3 - c(j,1)=c(j,2)+(c(j,3)-c(j,4)) - enddo - endif - if (itype(nres).eq.21) then - do j=1,3 - c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3)) - enddo - endif - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di, - & rad2deg*alph(i),rad2deg*omeg(i) - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit none - include 'DIMENSIONS' - include 'COMMON.CHAIN' - integer ires,nscat,i,j - double precision sccor(3,20),sccmj - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end diff --git a/source/wham/src/readrtns.F b/source/wham/src/readrtns.F index 9fa6137..ad038e2 100644 --- a/source/wham/src/readrtns.F +++ b/source/wham/src/readrtns.F @@ -93,6 +93,9 @@ call readi(controlcard,'CONSTR_DIST',constr_dist,0) write (iout,*) "with_dihed_constr ",with_dihed_constr, & " CONSTR_DIST",constr_dist + call readi(controlcard,'CONSTR_HOMOL',constr_homology,0) + write (iout,*) "with_homology_constr ",with_dihed_constr, + & " CONSTR_HOMOLOGY",constr_homology refstr = index(controlcard,'REFSTR').gt.0 pdbref = index(controlcard,'PDBREF').gt.0 dyn_ss=(index(controlcard,'DYN_SS').gt.0) diff --git a/source/wham/src/wham_calc1.F b/source/wham/src/wham_calc1.F index 61b9504..ec46232 100644 --- a/source/wham/src/wham_calc1.F +++ b/source/wham/src/wham_calc1.F @@ -84,7 +84,9 @@ c parameter (MaxHdim=200000) & eplus,eminus,logfac,tanhT,tt double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, & escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, - & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor + & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor, + & ehomology_constr,edfadis,edfator,edfanei,edfabet + integer ind_point(maxpoint),upindE,indE character*16 plik @@ -219,8 +221,8 @@ c parameter (MaxHdim=200000) c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet) do iparm=1,nParmSet #ifdef DEBUG - write (iout,'(2i5,21f8.2)') i,iparm, - & (enetb(k,i,iparm),k=1,21) + write (iout,'(2i5,22f8.2)') i,iparm, + & (enetb(k,i,iparm),k=1,22) #endif call restore_parm(iparm) #ifdef DEBUG @@ -305,10 +307,16 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft estr=enetb(18,i,iparm) esccor=enetb(19,i,iparm) edihcnstr=enetb(20,i,iparm) + ehomology_constr=enetb(22,i,iparm) + edfadis=enetb(23,i,iparm) + edfator=enetb(24,i,iparm) + edfanei=enetb(25,i,iparm) + edfabet=enetb(26,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 + & etors,etors_d,eello_turn3,eello_turn4,esccor, + & ehomology_constr,edfadis,edfator,edfanei,edfabet #endif #ifdef SPLITELE @@ -320,7 +328,8 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr+wdfa_dist*edfadis + & +wdfa_tor*edfator+wdfa_nei*edfanei+wdfa_beta*edfabet #else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) @@ -330,7 +339,8 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr+wdfa_dist*edfadis + & +wdfa_tor*edfator+wdfa_nei*edfanei+wdfa_beta*edfabet #endif #ifdef DEBUG write (iout,*) i,iparm,1.0d0/(beta_h(ib,iparm)*1.987D-3), @@ -579,7 +589,7 @@ c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet) do iparm=1,nParmSet #ifdef DEBUG write (iout,'(2i5,21f8.2)') i,iparm, - & (enetb(k,i,iparm),k=1,21) + & (enetb(k,i,iparm),k=1,22) #endif call restore_parm(iparm) #ifdef DEBUG @@ -664,10 +674,16 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft estr=enetb(18,i,iparm) esccor=enetb(19,i,iparm) edihcnstr=enetb(20,i,iparm) + edfadis=enetb(23,i,iparm) + edfator=enetb(24,i,iparm) + edfanei=enetb(25,i,iparm) + edfabet=enetb(26,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,edihcnstr + & etors,etors_d,eello_turn3,eello_turn4,esccor,edihcnstr, + & ehomology_constr+wdfa_dist*edfadis+wdfa_tor*edfator+ + & wdfa_nei*edfanei+wdfa_beta*edfabet #endif #ifdef SPLITELE @@ -679,7 +695,8 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr+wdfa_dist*edfadis + & +wdfa_tor*edfator+wdfa_nei*edfanei+wdfa_beta*edfabet #else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) @@ -689,7 +706,8 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr+wdfa_dist*edfadis + & +wdfa_tor*edfator+wdfa_nei*edfanei+wdfa_beta*edfabet #endif c write (iout,*) "i",i," ib",ib, c & " temp",1.0d0/(1.987d-3*beta_h(ib,iparm))," etot",etot, @@ -909,6 +927,7 @@ c write (iout,*) "me1",me1," scount",scount(me1) estr=enetb(18,t,iparm) esccor=enetb(19,t,iparm) edihcnstr=enetb(20,t,iparm) + ehomology_constr=enetb(22,t,iparm) do k=0,nGridT betaT=startGridT+k*delta_T temper=betaT @@ -1017,7 +1036,7 @@ c write (iout,*) ib," PotEmin",potEmin & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr eprim=ftprim(6)*evdw_t+ftprim(1)*welec*ees & +ftprim(1)*wtor*etors+ & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ @@ -1040,7 +1059,7 @@ c write (iout,*) ib," PotEmin",potEmin & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+ehomology_constr eprim=ftprim(6)*evdw_t+ftprim(1)*welec*(ees+evdw1) & +ftprim(1)*wtor*etors+ & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ diff --git a/source/wham/src/xdrf b/source/wham/src/xdrf deleted file mode 120000 index 26825c5..0000000 --- a/source/wham/src/xdrf +++ /dev/null @@ -1 +0,0 @@ -../../lib/xdrf \ No newline at end of file -- 1.7.9.5