noyes.f
parmread.F
pinorm.f
- printmat.f
probabl.F
read_coords.F
readpdb.f
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} )
#========================================
# 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)
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
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
+
& 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),
& 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),
--- /dev/null
+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/
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-----------------------------------------------------------------------
--- /dev/null
+ 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
--- /dev/null
+ 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
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),
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)
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)
--- /dev/null
+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}
--- /dev/null
+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}
--- /dev/null
+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}
--- /dev/null
+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}
--- /dev/null
+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}
+++ /dev/null
-##################################################################
-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
-
-
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
.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
--- /dev/null
+ 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===============================================================================
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
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
& +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
& +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
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
& 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)
& 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)
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,
& 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)'/
& '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,
& 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)'/
& '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
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
& 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
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
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
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
& 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),
& 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),
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
- 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)
+++ /dev/null
- 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
+++ /dev/null
- 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
& "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
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
--- /dev/null
+ 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
+++ /dev/null
- 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
stop
endif
#endif
-
call initialize
call openunits
+ call cinfo
call parmread
call read_control
call molread
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/
& 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
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
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
& +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
& +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
& 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
write (iout,*) i,list_conf(i),fdimless(i)
enddo
#endif
-c#undef DEBUG
do i=1,ncon
totfree(i)=fdimless(i)
enddo
#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.)
--- /dev/null
+ 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
+++ /dev/null
- 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
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)
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
integer itype_pdb(maxres)
logical seq_comp
integer i,j
+ write (iout,*) " MOLREAD: NRES",NRES
C
C Body
C
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)
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)'/
& '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'
endif
endif
+
nnt=1
nct=nres
print *,'NNT=',NNT,' NCT=',NCT
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
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
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
+
+
* 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.
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 '
& 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
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
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")
# 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} )
#=========================================
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
#=========================================
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
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
--- /dev/null
+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/
--- /dev/null
+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
--- /dev/null
+ 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
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)
********************************************************************************
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
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)
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)
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
+
store_parm.o \
timing.o \
wham_calc1.o \
+ dfa.o \
ssMD.o
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
./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
./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
+++ /dev/null
-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
-
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
+++ /dev/null
- 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
--- /dev/null
+ 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===============================================================================
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)
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",
& 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)
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)
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
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
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
& +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)
& +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
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
& 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)+
& 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)+
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,
& 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)'/
& '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,
& 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)'/
& '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
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
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
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
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
& 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),
& 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),
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
& 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)
+++ /dev/null
-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)
&'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
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
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
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
& +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)
& +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)=
include 'COMMON.IOUNITS'
include 'COMMON.GEO'
include 'COMMON.VAR'
+c include 'include_unres/COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.LOCAL'
include 'COMMON.NAMES'
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")
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)
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
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'
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----------------------------------------------------------------------
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
subroutine promienie(*)
implicit none
include 'DIMENSIONS'
+ include 'DIMENSIONS.ZSCOPT'
include 'COMMON.CONTROL'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
--- /dev/null
+ 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
+++ /dev/null
- 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
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)
& 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
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
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
& +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)
& +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),
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
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
& +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)
& +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,
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
& +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+
& +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+
+++ /dev/null
-../../lib/xdrf
\ No newline at end of file
projects / unres.git / commitdiff