--- /dev/null
+ module ene_calc
+!-----------------------------------------------------------------------------
+ use io_units
+ use wham_data
+!
+ use geometry_data, only:nres
+ use energy_data
+ use control_data, only:maxthetyp1
+ use energy, only:etotal,enerprint,rescale_weights
+#ifdef MPI
+ use MPI_data
+! include "mpif.h"
+! include "COMMON.MPI"
+#endif
+ implicit none
+!-----------------------------------------------------------------------------
+! COMMON.ALLPARM
+! common /allparm/
+ real(kind=8),dimension(:,:),allocatable :: ww_all !(max_ene,max_parm) ! max_eneW
+ real(kind=8),dimension(:),allocatable :: vbldp0_all,akp_all !(max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: vbldsc0_all,&
+ aksc_all,abond0_all !(maxbondterm,ntyp,max_parm)
+ real(kind=8),dimension(:,:),allocatable :: a0thet_all !(-ntyp:ntyp,max_parm)
+ real(kind=8),dimension(:,:,:,:,:),allocatable :: athet_all,&
+ bthet_all !(2,-ntyp:ntyp,-1:1,-1:1,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: polthet_all !(0:3,-ntyp:ntyp,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: gthet_all !(3,-ntyp:ntyp,max_parm)
+ real(kind=8),dimension(:,:),allocatable :: theta0_all,&
+ sig0_all,sigc0_all !(-ntyp:ntyp,max_parm)
+ real(kind=8),dimension(:,:,:,:,:),allocatable :: aa0thet_all
+!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm)
+ real(kind=8),dimension(:,:,:,:,:,:),allocatable :: aathet_all
+!(maxtheterm,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm)
+ real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: bbthet_all,&
+ ccthet_all,ddthet_all,eethet_all !(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+! & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm)
+ real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: ffthet_all1,&
+ ggthet_all1,ffthet_all2,ggthet_all2 !(maxdouble,maxdouble,maxtheterm3,
+! & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,max_parm)
+ real(kind=8),dimension(:,:),allocatable :: dsc_all,dsc0_all !(ntyp1,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: bsc_all !(maxlob,ntyp,max_parm)
+ real(kind=8),dimension(:,:,:,:),allocatable :: censc_all !(3,maxlob,-ntyp:ntyp,max_parm)
+ real(kind=8),dimension(:,:,:,:,:),allocatable :: gaussc_all !(3,3,maxlob,-ntyp:ntyp,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: sc_parmin_all !(65,ntyp,max_parm)
+ real(kind=8),dimension(:,:,:,:),allocatable :: v0_all
+!(-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ real(kind=8),dimension(:,:,:,:,:),allocatable :: v1_all,&
+ v2_all !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ real(kind=8),dimension(:,:,:,:),allocatable :: vlor1_all,&
+ vlor2_all,vlor3_all !(maxlor,maxtor,maxtor,max_parm)
+ real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: v1c_all,&
+ v1s_all !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: v2c_all
+!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: v2s_all
+!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: b1_all,b2_all !(2,-maxtor:maxtor,max_parm)
+ real(kind=8),dimension(:,:,:,:),allocatable :: cc_all,dd_all,&
+ ee_all !(2,2,-maxtor:maxtor,max_parm)
+ real(kind=8),dimension(:,:,:,:),allocatable :: ctilde_all,&
+ dtilde_all !(2,2,-maxtor:maxtor,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: b1tilde_all !(2,-maxtor:maxtor,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: app_all,bpp_all,&
+ ael6_all,ael3_all !(2,2,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: aad_all,&
+ bad_all !(ntyp,2,max_parm)
+ real(kind=8),dimension(:,:,:),allocatable :: aa_all,bb_all,&
+ augm_all,eps_all,sigma_all,r0_all,chi_all !(ntyp,ntyp,max_parm)
+ real(kind=8),dimension(:,:),allocatable :: chip_all,alp_all !(ntyp,max_parm)
+ real(kind=8),dimension(:),allocatable :: ebr_all,d0cm_all,&
+ akcm_all,akth_all,akct_all,v1ss_all,v2ss_all,v3ss_all !(max_parm)
+ real(kind=8),dimension(:,:,:,:,:),allocatable :: v1sccor_all,&
+ v2sccor_all !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm)
+ integer,dimension(:,:),allocatable :: nlob_all !(ntyp1,max_parm)
+ integer,dimension(:,:,:,:),allocatable :: nlor_all,&
+ nterm_all !(-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ integer,dimension(:,:,:,:,:),allocatable :: ntermd1_all,&
+ ntermd2_all !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ integer,dimension(:,:),allocatable :: nbondterm_all !(ntyp,max_parm)
+ integer,dimension(:,:),allocatable :: ithetyp_all !(-ntyp1:ntyp1,max_parm)
+ integer,dimension(:),allocatable :: nthetyp_all,ntheterm_all,&
+ ntheterm2_all,ntheterm3_all,nsingle_all,ndouble_all,&
+ nntheterm_all !(max_parm)
+ integer,dimension(:,:,:),allocatable :: nterm_sccor_all !(-ntyp:ntyp,-ntyp:ntyp,max_parm)
+!-----------------------------------------------------------------------------
+!
+!
+!-----------------------------------------------------------------------------
+ contains
+!-----------------------------------------------------------------------------
+ subroutine enecalc(islice,*)
+
+ use names
+ use control_data, only:indpdb
+ use geometry_data, only:c,phi,theta,alph,omeg,deg2rad,anatemp,&
+ vbld,rad2deg,dc_norm,dc,vbld_inv
+ use io_base, only:gyrate!,briefout
+ use geometry, only:int_from_cart1
+ use io_wham, only:pdboutW
+ use io_database, only:opentmp
+ use conform_compar, only:qwolynes,rmsnat
+! include "DIMENSIONS"
+! include "DIMENSIONS.ZSCOPT"
+! include "DIMENSIONS.FREE"
+#ifdef MPI
+! use MPI_data
+ include "mpif.h"
+! include "COMMON.MPI"
+#endif
+! include "COMMON.CHAIN"
+! include "COMMON.IOUNITS"
+! include "COMMON.PROTFILES"
+! include "COMMON.NAMES"
+! include "COMMON.VAR"
+! include "COMMON.SBRIDGE"
+! include "COMMON.GEO"
+! include "COMMON.FFIELD"
+! include "COMMON.ENEPS"
+! include "COMMON.LOCAL"
+! include "COMMON.WEIGHTS"
+! include "COMMON.INTERACT"
+! include "COMMON.FREE"
+! include "COMMON.ENERGIES"
+! include "COMMON.CONTROL"
+! include "COMMON.TORCNSTR"
+! implicit none
+#ifdef MPI
+ integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
+#endif
+ character(len=64) :: nazwa
+ character(len=80) :: bxname
+ character(len=3) :: liczba
+!el real(kind=8) :: qwolynes
+!el external qwolynes
+ integer :: errmsg_count,maxerrmsg_count=100
+!el real(kind=8) :: rmsnat,gyrate
+!el external rmsnat,gyrate
+ real(kind=8) :: tole=1.0d-1
+ integer i,itj,ii,iii,j,k,l,licz
+ integer ir,ib,ipar,iparm
+ integer iscor,islice
+ real(kind=4) :: csingle(3,nres*2)
+ real(kind=8) :: energ
+ real(kind=8) :: temp
+!el integer ilen,iroof
+!el external ilen,iroof
+ real(kind=8) :: energia(0:n_ene),rmsdev,efree,eini
+!el real(kind=8) :: energia(0:max_ene),rmsdev,efree,eini
+ real(kind=8) :: fT(6),quot,quotl,kfacl,kfac=2.4d0,T0=3.0d2
+ real(kind=8) :: tt
+ integer :: snk_p(MaxR,MaxT_h,nParmSet)!Max_parm)
+ logical :: lerr
+ character(len=64) :: bprotfile_temp
+
+! integer :: rec
+ integer,dimension(0:nprocs) :: scount_
+!el real(kind=8) :: rmsnat
+
+ rescale_mode=rescale_modeW
+
+ call opentmp(islice,ientout,bprotfile_temp)
+ iii=0
+ ii=0
+!el
+! iparm=1
+ errmsg_count=0
+ write (iout,*) "enecalc: nparmset ",nparmset
+#ifdef MPI
+ do iparm=1,nParmSet
+ do ib=1,nT_h(iparm)
+ do i=1,nR(ib,iparm)
+ snk_p(i,ib,iparm)=0
+ enddo
+ enddo
+ enddo
+ do i=indstart(me1),indend(me1)
+write(iout,*)"enecalc_ i indstart",i,indstart(me1),indend(me1)
+#else
+ do iparm=1,nParmSet
+ do ib=1,nT_h(iparm)
+ do i=1,nR(ib,iparm)
+ snk(i,ib,iparm)=0
+ enddo
+ enddo
+ enddo
+ do i=1,ntot
+write(iout,*)"enecalc_ i ntot",i,ntot
+#endif
+ read(ientout,rec=i,err=101) &
+ ((csingle(l,k),l=1,3),k=1,nres),&
+ ((csingle(l,k+nres),l=1,3),k=nnt,nct),&
+ nss,(ihpb(k),jhpb(k),k=1,nss),&
+ eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
+!el debug
+!write(iout,*)"co wczytuje"
+! write(iout,*)((csingle(l,k),l=1,3),k=1,nres),&
+! ((csingle(l,k+nres),l=1,3),k=nnt,nct),&
+! nss,(ihpb(k),jhpb(k),k=1,nss),&
+! eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
+!el --------
+
+!write(iout,*)"ipar",ib,ipar,1.0d0/(beta_h(ib,ipar)*1.987D-3)
+ if (indpdb.gt.0) then
+ do k=1,nres
+ do l=1,3
+ c(l,k)=csingle(l,k)
+ enddo
+ enddo
+ do k=nnt,nct
+ do l=1,3
+ c(l,k+nres)=csingle(l,k+nres)
+ enddo
+ enddo
+ anatemp= 1.0d0/(beta_h(ib,ipar)*1.987D-3)
+ q(nQ+1,iii+1)=rmsnat(iii+1)
+ endif
+ q(nQ+2,iii+1)=gyrate(iii+1)
+! write(iout,*)"wczyt",anatemp,q(nQ+2,iii+1) !el
+! fT=T0*beta_h(ib,ipar)*1.987D-3
+! ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3))
+! EL start old rescale
+! if (rescale_modeW.eq.1) then
+! quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
+!#if defined(FUNCTH)
+! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
+! ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
+!#elif defined(FUNCT)
+! ft(6)=quot
+!#else
+! ft(6)=1.0d0
+!#endif
+! quotl=1.0d0
+! kfacl=1.0d0
+! do l=1,5
+! quotl=quotl*quot
+! kfacl=kfacl*kfac
+! fT(l)=kfacl/(kfacl-1.0d0+quotl)
+! enddo
+! else if (rescale_modeW.eq.2) then
+! quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
+!#if defined(FUNCTH)
+! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
+! ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
+!#elif defined(FUNCT)
+! ft(6)=quot
+!#else
+! ft(6)=1.0d0
+!#endif
+! quotl=1.0d0
+! do l=1,5
+! quotl=quotl*quot
+! fT(l)=1.12692801104297249644d0/ &
+! dlog(dexp(quotl)+dexp(-quotl))
+! enddo
+! else if (rescale_modeW.eq.0) then
+! do l=1,5
+! fT(l)=1.0d0
+! enddo
+! else
+! write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",&
+! rescale_modeW
+! call flush(iout)
+! return 1
+! endif
+!EL end old rescele
+! write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0,
+! & " kfac",kfac,"quot",quot," fT",fT
+#ifdef DEBUG
+ write(iout,*)"weights"
+ write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,&
+ wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,&
+ wtor_d,wsccor,wbond
+#endif
+
+ do j=1,2*nres
+ do k=1,3
+ c(k,j)=csingle(k,j)
+ enddo
+ enddo
+ call int_from_cart1(.false.)
+ ii=ii+1
+
+! call rescale_weights(1.0d0/(beta_h(ib,ipar)*1.987D-3))
+ do iparm=1,nparmset
+#ifdef DEBUG
+ write (iout,*) "before restore w=",1.0d0/(beta_h(ib,ipar)*1.987D-3)
+ write(iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,&
+ wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,&
+ wtor_d,wsccor,wbond
+#endif
+ call restore_parm(iparm)
+ call rescale_weights(1.0d0/(beta_h(ib,ipar)*1.987D-3))
+#ifdef DEBUG
+ write (iout,*) "before etot w=",1.0d0/(beta_h(ib,ipar)*1.987D-3)
+ write(iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,&
+ wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,&
+ wtor_d,wsccor,wbond
+#endif
+! call etotal(energia(0),fT)
+ call etotal(energia(0))
+!write(iout,*)"check c and dc after etotal",1.0d0/(0.001987*beta_h(ib,ipar))
+!do k=1,2*nres+2
+!write(iout,*)k,"c=",(c(l,k),l=1,3)
+!write(iout,*)k,"dc=",(dc(l,k),l=1,3)
+!write(iout,*)k,"dc_norm=",(dc_norm(l,k),l=1,3)
+!enddo
+!do k=1,nres*2
+!write(iout,*)k,"vbld=",vbld(k)
+!write(iout,*)k,"vbld_inv=",vbld_inv(k)
+!enddo
+
+!write(iout,*)"energia",(energia(j),j=0,n_ene)
+!write(iout,*)"enerprint tuz po call etotal"
+ call enerprint(energia(0))
+#ifdef DEBUG
+ write (iout,*) "Conformation",i
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+! call enerprint(energia(0),fT)
+ call enerprint(energia(0))
+ write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
+ write (iout,*) "ftors",ftors
+!el call briefout(i,energia(0))
+ temp=1.0d0/(beta_h(ib,ipar)*1.987D-3)
+ write (iout,*) "temp", temp
+ call pdboutW(i,temp,energia(0),energia(0),0.0d0,0.0d0)
+#endif
+ if (energia(0).ge.1.0d20) then
+ write (iout,*) "NaNs detected in some of the energy",&
+ " components for conformation",ii+1
+ write (iout,*) "The Cartesian geometry is:"
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+ write (iout,*) "The internal geometry is:"
+! call intout
+! call pdboutW(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
+ write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+ write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+ write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+ write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+ write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+ write (iout,*) "The components of the energy are:"
+! call enerprint(energia(0),fT)
+ call enerprint(energia(0))
+ write (iout,*) &
+ "This conformation WILL NOT be added to the database."
+ call flush(iout)
+ goto 121
+ else
+#ifdef DEBUG
+ if (ipar.eq.iparm) write (iout,*) i,iparm,&
+ 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
+#endif
+ if (ipar.eq.iparm .and. einicheck.gt.0 .and. &
+ dabs(eini-energia(0)).gt.tole) then
+ if (errmsg_count.le.maxerrmsg_count) then
+ write (iout,'(2a,2e15.5,a,2i8,a,f8.1)') &
+ "Warning: energy differs remarkably from ",&
+ " the value read in: ",energia(0),eini," point",&
+ iii+1,indstart(me1)+iii," T",&
+ 1.0d0/(1.987D-3*beta_h(ib,ipar))
+! call intout
+ call pdboutW(indstart(me1)+iii,&
+ 1.0d0/(1.987D-3*beta_h(ib,ipar)),&
+ energia(0),eini,0.0d0,0.0d0)
+ write (iout,*) "The Cartesian geometry is:"
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+ write (iout,*) "The internal geometry is:"
+! call intout
+! call pdboutW(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
+ write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+ write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+ write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+ write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+ write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+ call enerprint(energia(0))
+! call enerprint(energia(0),fT)
+ errmsg_count=errmsg_count+1
+ if (errmsg_count.gt.maxerrmsg_count) &
+ write (iout,*) "Too many warning messages"
+ if (einicheck.gt.1) then
+ write (iout,*) "Calculation stopped."
+ call flush(iout)
+#ifdef MPI
+ call MPI_Abort(WHAM_COMM,IERROR,ERRCODE)
+#endif
+ call flush(iout)
+ return 1
+ endif
+ endif
+ endif
+ potE(iii+1,iparm)=energia(0)
+ do k=1,21
+ enetb(k,iii+1,iparm)=energia(k)
+ enddo
+! write (iout,'(2i5,21f8.2)') "debug",k,iii+1,(enetb(k,iii+1,iparm),k=1,21)
+! write (iout,*) "debug",k,iii+1,(enetb(k,iii+1,iparm),k=1,21)
+#ifdef DEBUG
+ write (iout,'(2i5,f10.1,3e15.5)') i,iii,&
+ 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree
+! call enerprint(energia(0),fT)
+#endif
+#ifdef DEBUG
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+ write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+ write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+ write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+ write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+ write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
+ write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ)
+ write (iout,'(f10.5,i10)') rmsdev,iscor
+! call enerprint(energia(0),fT)
+ call enerprint(energia(0))
+ call pdboutW(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
+#endif
+ endif
+
+ enddo ! iparm
+
+ iii=iii+1
+ if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) q(1,iii)=qwolynes(0,0)
+ write (ientout,rec=iii) &
+ ((csingle(l,k),l=1,3),k=1,nres),&
+ ((csingle(l,k+nres),l=1,3),k=nnt,nct),&
+ nss,(ihpb(k),jhpb(k),k=1,nss),&
+ potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar
+! write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree
+#ifdef MPI
+ if (separate_parset) then
+ snk_p(iR,ib,1)=snk_p(iR,ib,1)+1
+ else
+ snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1
+ endif
+! write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar,
+! & " snk",snk_p(iR,ib,ipar)
+#else
+ snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1
+#endif
+ 121 continue
+ enddo
+#ifdef MPI
+ scount(me)=iii
+ write (iout,*) "Me",me," scount",scount(me)
+ call flush(iout)
+! Master gathers updated numbers of conformations written by all procs.
+ call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount_(0), 1, &
+ MPI_INTEGER, WHAM_COMM, IERROR)
+ indstart(0)=1
+ indend(0)=scount_(0)
+ do i=1, Nprocs-1
+ indstart(i)=indend(i-1)+1
+ indend(i)=indstart(i)+scount_(i)-1
+ enddo
+ write (iout,*)
+ write (iout,*) "Revised conformation counts"
+ do i=0,nprocs1-1
+ write (iout,'(a,i5,a,i7,a,i7,a,i7)') &
+ "Processor",i," indstart",indstart(i),&
+ " indend",indend(i)," count",scount_(i)
+ enddo
+ call flush(iout)
+ call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),&
+ MaxR*MaxT_h*nParmSet,&
+ MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
+#endif
+ stot(islice)=0
+ do iparm=1,nParmSet
+ do ib=1,nT_h(iparm)
+ do i=1,nR(ib,iparm)
+ stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
+ enddo
+ enddo
+ enddo
+ write (iout,*) "Revised SNK"
+ do iparm=1,nParmSet
+ do ib=1,nT_h(iparm)
+ write (iout,'("Param",i3," Temp",f6.1,3x,32i8)') &
+ iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),&
+ (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
+ write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
+ enddo
+ enddo
+ write (iout,'("Total",i10)') stot(islice)
+ call flush(iout)
+ do i=0,nprocs
+ scount(i)=scount_(i)
+ enddo
+ return
+ 101 write (iout,*) "Error in scratchfile."
+ call flush(iout)
+!el#undef DEBUG
+ return 1
+ end subroutine enecalc
+!------------------------------------------------------------------------------
+ logical function conf_check(ii,iprint)
+
+ use geometry_data, only:c,phi,theta,alph,omeg,deg2rad,rad2deg,vbld
+ use geometry, only:int_from_cart1
+! include "DIMENSIONS"
+! include "DIMENSIONS.ZSCOPT"
+! include "DIMENSIONS.FREE"
+#ifdef MPI
+! use MPI_data
+ include "mpif.h"
+! include "COMMON.MPI"
+#endif
+! include "COMMON.CHAIN"
+! include "COMMON.IOUNITS"
+! include "COMMON.PROTFILES"
+! include "COMMON.NAMES"
+! include "COMMON.VAR"
+! include "COMMON.SBRIDGE"
+! include "COMMON.GEO"
+! include "COMMON.FFIELD"
+! include "COMMON.ENEPS"
+! include "COMMON.LOCAL"
+! include "COMMON.WEIGHTS"
+! include "COMMON.INTERACT"
+! include "COMMON.FREE"
+! include "COMMON.ENERGIES"
+! include "COMMON.CONTROL"
+! include "COMMON.TORCNSTR"
+! implicit none
+#ifdef MPI
+ integer :: IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
+#endif
+ integer :: j,k,l,ii,itj,iprint
+ if (.not.check_conf) then
+ conf_check=.true.
+ return
+ endif
+ call int_from_cart1(.false.)
+ do j=nnt+1,nct
+ if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and. &
+ (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then
+ if (iprint.gt.0) &
+ write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),&
+ " for conformation",ii
+ if (iprint.gt.1) then
+ write (iout,*) "The Cartesian geometry is:"
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+ write (iout,*) "The internal geometry is:"
+ write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+ write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+ write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+ write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+ write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+ endif
+ if (iprint.gt.0) write (iout,*) &
+ "This conformation WILL NOT be added to the database."
+ conf_check=.false.
+ return
+ endif
+ enddo
+ do j=nnt,nct
+ itj=itype(j)
+ if (itype(j).ne.10 .and.itype(j).ne.ntyp1 .and. &
+ (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0) then
+ if (iprint.gt.0) &
+ write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),&
+ " for conformation",ii
+ if (iprint.gt.1) then
+ write (iout,*) "The Cartesian geometry is:"
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+ write (iout,*) "The internal geometry is:"
+ write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+ write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+ write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+ write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+ write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+ endif
+ if (iprint.gt.0) write (iout,*) &
+ "This conformation WILL NOT be added to the database."
+ conf_check=.false.
+ return
+ endif
+ enddo
+ do j=3,nres
+ if (theta(j).le.0.0d0) then
+ if (iprint.gt.0) &
+ write (iout,*) "Zero theta angle(s) in conformation",ii
+ if (iprint.gt.1) then
+ write (iout,*) "The Cartesian geometry is:"
+ write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+ write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+ write (iout,*) "The internal geometry is:"
+ write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+ write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+ write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+ write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+ write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+ write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+ endif
+ if (iprint.gt.0) write (iout,*) &
+ "This conformation WILL NOT be added to the database."
+ conf_check=.false.
+ return
+ endif
+ if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
+ enddo
+ conf_check=.true.
+! write (iout,*) "conf_check passed",ii
+ return
+ end function conf_check
+!-----------------------------------------------------------------------------
+! store_parm.F
+!-----------------------------------------------------------------------------
+ subroutine store_parm(iparm)
+!
+! Store parameters of set IPARM
+! valence angles and the side chains and energy parameters.
+!
+! implicit none
+! include 'DIMENSIONS'
+! include 'DIMENSIONS.ZSCOPT'
+! include 'DIMENSIONS.FREE'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.INTERACT'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.TORSION'
+! include 'COMMON.FFIELD'
+! include 'COMMON.NAMES'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.SCROT'
+! include 'COMMON.SCCOR'
+! include 'COMMON.ALLPARM'
+ integer :: i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
+
+ call alloc_enecalc_arrays(iparm)
+!el allocate(ww_all(n_ene,iparm))
+! Store weights
+ ww_all(1,iparm)=wsc
+ ww_all(2,iparm)=wscp
+ ww_all(3,iparm)=welec
+ ww_all(4,iparm)=wcorr
+ ww_all(5,iparm)=wcorr5
+ ww_all(6,iparm)=wcorr6
+ ww_all(7,iparm)=wel_loc
+ ww_all(8,iparm)=wturn3
+ ww_all(9,iparm)=wturn4
+ ww_all(10,iparm)=wturn6
+ ww_all(11,iparm)=wang
+ ww_all(12,iparm)=wscloc
+ ww_all(13,iparm)=wtor
+ ww_all(14,iparm)=wtor_d
+ ww_all(15,iparm)=wstrain
+ ww_all(16,iparm)=wvdwpp
+ ww_all(17,iparm)=wbond
+ ww_all(19,iparm)=wsccor
+! Store bond parameters
+ vbldp0_all(iparm)=vbldp0
+ akp_all(iparm)=akp
+ do i=1,ntyp
+ nbondterm_all(i,iparm)=nbondterm(i)
+ do j=1,nbondterm(i)
+ vbldsc0_all(j,i,iparm)=vbldsc0(j,i)
+ aksc_all(j,i,iparm)=aksc(j,i)
+ abond0_all(j,i,iparm)=abond0(j,i)
+ enddo
+ enddo
+! Store bond angle parameters
+#ifdef CRYST_THETA
+ do i=-ntyp,ntyp
+ a0thet_all(i,iparm)=a0thet(i)
+ do ichir1=-1,1
+ do ichir2=-1,1
+ do j=1,2
+ athet_all(j,i,ichir1,ichir2,iparm)=athet(j,i,ichir1,ichir2)
+ bthet_all(j,i,ichir1,ichir2,iparm)=bthet(j,i,ichir1,ichir2)
+ enddo
+ enddo
+ enddo
+ do j=0,3
+ polthet_all(j,i,iparm)=polthet(j,i)
+ enddo
+ do j=1,3
+ gthet_all(j,i,iparm)=gthet(j,i)
+ enddo
+ theta0_all(i,iparm)=theta0(i)
+ sig0_all(i,iparm)=sig0(i)
+ sigc0_all(i,iparm)=sigc0(i)
+ enddo
+#else
+ nthetyp_all(iparm)=nthetyp
+ ntheterm_all(iparm)=ntheterm
+ ntheterm2_all(iparm)=ntheterm2
+ ntheterm3_all(iparm)=ntheterm3
+ nsingle_all(iparm)=nsingle
+ ndouble_all(iparm)=ndouble
+ nntheterm_all(iparm)=nntheterm
+ do i=-ntyp,ntyp
+ ithetyp_all(i,iparm)=ithetyp(i)
+ enddo
+ do iblock=1,2
+ do i=-maxthetyp1,maxthetyp1
+ do j=-maxthetyp1,maxthetyp1
+ do k=-maxthetyp1,maxthetyp1
+ aa0thet_all(i,j,k,iblock,iparm)=aa0thet(i,j,k,iblock)
+ do l=1,ntheterm
+ aathet_all(l,i,j,k,iblock,iparm)=aathet(l,i,j,k,iblock)
+ enddo
+ do l=1,ntheterm2
+ do m=1,nsingle
+ bbthet_all(m,l,i,j,k,iblock,iparm)= &
+ bbthet(m,l,i,j,k,iblock)
+ ccthet_all(m,l,i,j,k,iblock,iparm)= &
+ ccthet(m,l,i,j,k,iblock)
+ ddthet_all(m,l,i,j,k,iblock,iparm)= &
+ ddthet(m,l,i,j,k,iblock)
+ eethet_all(m,l,i,j,k,iblock,iparm)= &
+ eethet(m,l,i,j,k,iblock)
+ enddo
+ enddo
+ do l=1,ntheterm3
+ do m=1,ndouble
+ do mm=1,ndouble
+ if (iblock.eq.1) then
+ ffthet_all1(mm,m,l,i,j,k,iparm)=&
+ ffthet(mm,m,l,i,j,k,iblock)
+ ggthet_all1(mm,m,l,i,j,k,iparm)=&
+ ggthet(mm,m,l,i,j,k,iblock)
+ else
+ ffthet_all2(mm,m,l,i,j,k,iparm)=&
+ ffthet(mm,m,l,i,j,k,iblock)
+ ggthet_all2(mm,m,l,i,j,k,iparm)=&
+ ggthet(mm,m,l,i,j,k,iblock)
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+#endif
+#ifdef CRYST_SC
+! Store the sidechain rotamer parameters
+ do i=-ntyp,ntyp
+ iii=iabs(i)
+!! write (iout,*) i,"storeparm1"
+ if (i.eq.0) cycle
+ nlob_all(iii,iparm)=nlob(iii)
+ do j=1,nlob(iii)
+ bsc_all(j,iii,iparm)=bsc(j,iii)
+ do k=1,3
+ censc_all(k,j,i,iparm)=censc(k,j,i)
+ enddo
+ do k=1,3
+ do l=1,3
+ gaussc_all(l,k,j,i,iparm)=gaussc(l,k,j,i)
+ enddo
+ enddo
+ enddo
+ enddo
+#else
+ do i=1,ntyp
+ do j=1,65
+ sc_parmin_all(j,i,iparm)=sc_parmin(j,i)
+ enddo
+ enddo
+#endif
+! Store the torsional parameters
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ v0_all(i,j,iblock,iparm)=v0(i,j,iblock)
+ nterm_all(i,j,iblock,iparm)=nterm(i,j,iblock)
+ nlor_all(i,j,iblock,iparm)=nlor(i,j,iblock)
+ do k=1,nterm(i,j,iblock)
+ v1_all(k,i,j,iblock,iparm)=v1(k,i,j,iblock)
+ v2_all(k,i,j,iblock,iparm)=v2(k,i,j,iblock)
+ enddo
+ do k=1,nlor(i,j,iblock)
+ vlor1_all(k,i,j,iparm)=vlor1(k,i,j)
+ vlor2_all(k,i,j,iparm)=vlor2(k,i,j)
+ vlor3_all(k,i,j,iparm)=vlor3(k,i,j)
+ enddo
+ enddo
+ enddo
+ enddo
+! Store the double torsional parameters
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
+ ntermd1_all(i,j,k,iblock,iparm)=ntermd_1(i,j,k,iblock)
+ ntermd2_all(i,j,k,iblock,iparm)=ntermd_2(i,j,k,iblock)
+ do l=1,ntermd_1(i,j,k,iblock)
+ v1c_all(1,l,i,j,k,iblock,iparm)=v1c(1,l,i,j,k,iblock)
+ v1c_all(2,l,i,j,k,iblock,iparm)=v1c(2,l,i,j,k,iblock)
+ v2c_all(1,l,i,j,k,iblock,iparm)=v2c(1,l,i,j,k,iblock)
+ v2c_all(2,l,i,j,k,iblock,iparm)=v2c(2,l,i,j,k,iblock)
+ enddo
+ do l=1,ntermd_2(i,j,k,iblock)
+ do m=1,ntermd_2(i,j,k,iblock)
+ v2s_all(l,m,i,j,k,iblock,iparm)=v2s(l,m,i,j,k,iblock)
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+! Store parameters of the cumulants
+ do i=-nloctyp,nloctyp
+ do j=1,2
+ b1_all(j,i,iparm)=b1(j,i)
+ b1tilde_all(j,i,iparm)=b1tilde(j,i)
+ b2_all(j,i,iparm)=b2(j,i)
+ enddo
+ do j=1,2
+ do k=1,2
+ cc_all(k,j,i,iparm)=cc(k,j,i)
+ ctilde_all(k,j,i,iparm)=ctilde(k,j,i)
+ dd_all(k,j,i,iparm)=dd(k,j,i)
+ dtilde_all(k,j,i,iparm)=dtilde(k,j,i)
+ ee_all(k,j,i,iparm)=ee(k,j,i)
+ enddo
+ enddo
+ enddo
+! Store the parameters of electrostatic interactions
+ do i=1,2
+ do j=1,2
+ app_all(j,i,iparm)=app(j,i)
+ bpp_all(j,i,iparm)=bpp(j,i)
+ ael6_all(j,i,iparm)=ael6(j,i)
+ ael3_all(j,i,iparm)=ael3(j,i)
+ enddo
+ enddo
+! Store sidechain parameters
+ do i=1,ntyp
+ do j=1,ntyp
+ aa_all(j,i,iparm)=aa(j,i)
+ bb_all(j,i,iparm)=bb(j,i)
+ r0_all(j,i,iparm)=r0(j,i)
+ sigma_all(j,i,iparm)=sigma(j,i)
+ chi_all(j,i,iparm)=chi(j,i)
+ augm_all(j,i,iparm)=augm(j,i)
+ eps_all(j,i,iparm)=eps(j,i)
+ enddo
+ enddo
+ do i=1,ntyp
+ chip_all(i,iparm)=chip(i)
+ alp_all(i,iparm)=alp(i)
+ enddo
+! Store the SCp parameters
+ do i=1,ntyp
+ do j=1,2
+ aad_all(i,j,iparm)=aad(i,j)
+ bad_all(i,j,iparm)=bad(i,j)
+ enddo
+ enddo
+! Store disulfide-bond parameters
+ ebr_all(iparm)=ebr
+ d0cm_all(iparm)=d0cm
+ akcm_all(iparm)=akcm
+ akth_all(iparm)=akth
+ akct_all(iparm)=akct
+ v1ss_all(iparm)=v1ss
+ v2ss_all(iparm)=v2ss
+ v3ss_all(iparm)=v3ss
+! Store SC-backbone correlation parameters
+ do i=-nsccortyp,nsccortyp
+ do j=-nsccortyp,nsccortyp
+
+ nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i)
+! do i=1,20
+! do j=1,20
+ do l=1,3
+ do k=1,nterm_sccor(j,i)
+ v1sccor_all(k,l,j,i,iparm)=v1sccor(k,l,j,i)
+ v2sccor_all(k,l,j,i,iparm)=v2sccor(k,l,j,i)
+ enddo
+ enddo
+ enddo
+ enddo
+write(iout,*)"end of store_parm"
+ return
+ end subroutine store_parm
+!--------------------------------------------------------------------------
+ subroutine restore_parm(iparm)
+!
+! Store parameters of set IPARM
+! valence angles and the side chains and energy parameters.
+!
+! implicit none
+! include 'DIMENSIONS'
+! include 'DIMENSIONS.ZSCOPT'
+! include 'DIMENSIONS.FREE'
+! include 'COMMON.IOUNITS'
+! include 'COMMON.CHAIN'
+! include 'COMMON.INTERACT'
+! include 'COMMON.GEO'
+! include 'COMMON.LOCAL'
+! include 'COMMON.TORSION'
+! include 'COMMON.FFIELD'
+! include 'COMMON.NAMES'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.SCROT'
+! include 'COMMON.SCCOR'
+! include 'COMMON.ALLPARM'
+ integer :: i,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii
+
+! Restore weights
+ wsc=ww_all(1,iparm)
+ wscp=ww_all(2,iparm)
+ welec=ww_all(3,iparm)
+ wcorr=ww_all(4,iparm)
+ wcorr5=ww_all(5,iparm)
+ wcorr6=ww_all(6,iparm)
+ wel_loc=ww_all(7,iparm)
+ wturn3=ww_all(8,iparm)
+ wturn4=ww_all(9,iparm)
+ wturn6=ww_all(10,iparm)
+ wang=ww_all(11,iparm)
+ wscloc=ww_all(12,iparm)
+ wtor=ww_all(13,iparm)
+ wtor_d=ww_all(14,iparm)
+ wstrain=ww_all(15,iparm)
+ wvdwpp=ww_all(16,iparm)
+ wbond=ww_all(17,iparm)
+ wsccor=ww_all(19,iparm)
+! Restore bond parameters
+ vbldp0=vbldp0_all(iparm)
+ akp=akp_all(iparm)
+ do i=1,ntyp
+ nbondterm(i)=nbondterm_all(i,iparm)
+ do j=1,nbondterm(i)
+ vbldsc0(j,i)=vbldsc0_all(j,i,iparm)
+ aksc(j,i)=aksc_all(j,i,iparm)
+ abond0(j,i)=abond0_all(j,i,iparm)
+ enddo
+ enddo
+! Restore bond angle parameters
+#ifdef CRYST_THETA
+ do i=-ntyp,ntyp
+ a0thet(i)=a0thet_all(i,iparm)
+ do ichir1=-1,1
+ do ichir2=-1,1
+ do j=1,2
+ athet(j,i,ichir1,ichir2)=athet_all(j,i,ichir1,ichir2,iparm)
+ bthet(j,i,ichir1,ichir2)=bthet_all(j,i,ichir1,ichir2,iparm)
+ enddo
+ enddo
+ enddo
+ do j=0,3
+ polthet(j,i)=polthet_all(j,i,iparm)
+ enddo
+ do j=1,3
+ gthet(j,i)=gthet_all(j,i,iparm)
+ enddo
+ theta0(i)=theta0_all(i,iparm)
+ sig0(i)=sig0_all(i,iparm)
+ sigc0(i)=sigc0_all(i,iparm)
+ enddo
+#else
+ nthetyp=nthetyp_all(iparm)
+ ntheterm=ntheterm_all(iparm)
+ ntheterm2=ntheterm2_all(iparm)
+ ntheterm3=ntheterm3_all(iparm)
+ nsingle=nsingle_all(iparm)
+ ndouble=ndouble_all(iparm)
+ nntheterm=nntheterm_all(iparm)
+ do i=-ntyp,ntyp
+ ithetyp(i)=ithetyp_all(i,iparm)
+ enddo
+ do iblock=1,2
+ do i=-maxthetyp1,maxthetyp1
+ do j=-maxthetyp1,maxthetyp1
+ do k=-maxthetyp1,maxthetyp1
+ aa0thet(i,j,k,iblock)=aa0thet_all(i,j,k,iblock,iparm)
+ do l=1,ntheterm
+ aathet(l,i,j,k,iblock)=aathet_all(l,i,j,k,iblock,iparm)
+ enddo
+ do l=1,ntheterm2
+ do m=1,nsingle
+ bbthet(m,l,i,j,k,iblock)= &
+ bbthet_all(m,l,i,j,k,iblock,iparm)
+ ccthet(m,l,i,j,k,iblock)= &
+ ccthet_all(m,l,i,j,k,iblock,iparm)
+ ddthet(m,l,i,j,k,iblock)= &
+ ddthet_all(m,l,i,j,k,iblock,iparm)
+ eethet(m,l,i,j,k,iblock)= &
+ eethet_all(m,l,i,j,k,iblock,iparm)
+ enddo
+ enddo
+ do l=1,ntheterm3
+ do m=1,ndouble
+ do mm=1,ndouble
+ if (iblock.eq.1) then
+ ffthet(mm,m,l,i,j,k,iblock)= &
+ ffthet_all1(mm,m,l,i,j,k,iparm)
+ ggthet(mm,m,l,i,j,k,iblock)= &
+ ggthet_all1(mm,m,l,i,j,k,iparm)
+ else
+ ffthet(mm,m,l,i,j,k,iblock)= &
+ ffthet_all2(mm,m,l,i,j,k,iparm)
+ ggthet(mm,m,l,i,j,k,iblock)= &
+ ggthet_all2(mm,m,l,i,j,k,iparm)
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+#endif
+! Restore the sidechain rotamer parameters
+#ifdef CRYST_SC
+ do i=-ntyp,ntyp
+ if (i.eq.0) cycle
+ iii=iabs(i)
+ nlob(iii)=nlob_all(iii,iparm)
+ do j=1,nlob(iii)
+ bsc(j,iii)=bsc_all(j,iii,iparm)
+ do k=1,3
+ censc(k,j,i)=censc_all(k,j,i,iparm)
+ enddo
+ do k=1,3
+ do l=1,3
+ gaussc(l,k,j,i)=gaussc_all(l,k,j,i,iparm)
+ enddo
+ enddo
+ enddo
+ enddo
+#else
+ do i=1,ntyp
+ do j=1,65
+ sc_parmin(j,i)=sc_parmin_all(j,i,iparm)
+ enddo
+ enddo
+#endif
+! Restore the torsional parameters
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ v0(i,j,iblock)=v0_all(i,j,iblock,iparm)
+ nterm(i,j,iblock)=nterm_all(i,j,iblock,iparm)
+ nlor(i,j,iblock)=nlor_all(i,j,iblock,iparm)
+ do k=1,nterm(i,j,iblock)
+ v1(k,i,j,iblock)=v1_all(k,i,j,iblock,iparm)
+ v2(k,i,j,iblock)=v2_all(k,i,j,iblock,iparm)
+ enddo
+ do k=1,nlor(i,j,iblock)
+ vlor1(k,i,j)=vlor1_all(k,i,j,iparm)
+ vlor2(k,i,j)=vlor2_all(k,i,j,iparm)
+ vlor3(k,i,j)=vlor3_all(k,i,j,iparm)
+ enddo
+ enddo
+ enddo
+ enddo
+! Restore the double torsional parameters
+ do iblock=1,2
+ do i=-ntortyp+1,ntortyp-1
+ do j=-ntortyp+1,ntortyp-1
+ do k=-ntortyp+1,ntortyp-1
+ ntermd_1(i,j,k,iblock)=ntermd1_all(i,j,k,iblock,iparm)
+ ntermd_2(i,j,k,iblock)=ntermd2_all(i,j,k,iblock,iparm)
+ do l=1,ntermd_1(i,j,k,iblock)
+ v1c(1,l,i,j,k,iblock)=v1c_all(1,l,i,j,k,iblock,iparm)
+ v1c(2,l,i,j,k,iblock)=v1c_all(2,l,i,j,k,iblock,iparm)
+ v2c(1,l,i,j,k,iblock)=v2c_all(1,l,i,j,k,iblock,iparm)
+ v2c(2,l,i,j,k,iblock)=v2c_all(2,l,i,j,k,iblock,iparm)
+ enddo
+ do l=1,ntermd_2(i,j,k,iblock)
+ do m=1,ntermd_2(i,j,k,iblock)
+ v2s(l,m,i,j,k,iblock)=v2s_all(l,m,i,j,k,iblock,iparm)
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+ enddo
+! Restore parameters of the cumulants
+ do i=-nloctyp,nloctyp
+ do j=1,2
+ b1(j,i)=b1_all(j,i,iparm)
+ b1tilde(j,i)=b1tilde_all(j,i,iparm)
+ b2(j,i)=b2_all(j,i,iparm)
+ enddo
+ do j=1,2
+ do k=1,2
+ cc(k,j,i)=cc_all(k,j,i,iparm)
+ ctilde(k,j,i)=ctilde_all(k,j,i,iparm)
+ dd(k,j,i)=dd_all(k,j,i,iparm)
+ dtilde(k,j,i)=dtilde_all(k,j,i,iparm)
+ ee(k,j,i)=ee_all(k,j,i,iparm)
+ enddo
+ enddo
+ enddo
+! Restore the parameters of electrostatic interactions
+ do i=1,2
+ do j=1,2
+ app(j,i)=app_all(j,i,iparm)
+ bpp(j,i)=bpp_all(j,i,iparm)
+ ael6(j,i)=ael6_all(j,i,iparm)
+ ael3(j,i)=ael3_all(j,i,iparm)
+ enddo
+ enddo
+! Restore sidechain parameters
+ do i=1,ntyp
+ do j=1,ntyp
+ aa(j,i)=aa_all(j,i,iparm)
+ bb(j,i)=bb_all(j,i,iparm)
+ r0(j,i)=r0_all(j,i,iparm)
+ sigma(j,i)=sigma_all(j,i,iparm)
+ chi(j,i)=chi_all(j,i,iparm)
+ augm(j,i)=augm_all(j,i,iparm)
+ eps(j,i)=eps_all(j,i,iparm)
+ enddo
+ enddo
+ do i=1,ntyp
+ chip(i)=chip_all(i,iparm)
+ alp(i)=alp_all(i,iparm)
+ enddo
+! Restore the SCp parameters
+ do i=1,ntyp
+ do j=1,2
+ aad(i,j)=aad_all(i,j,iparm)
+ bad(i,j)=bad_all(i,j,iparm)
+ enddo
+ enddo
+! Restore disulfide-bond parameters
+ ebr=ebr_all(iparm)
+ d0cm=d0cm_all(iparm)
+ akcm=akcm_all(iparm)
+ akth=akth_all(iparm)
+ akct=akct_all(iparm)
+ v1ss=v1ss_all(iparm)
+ v2ss=v2ss_all(iparm)
+ v3ss=v3ss_all(iparm)
+! Restore SC-backbone correlation parameters
+ do i=-nsccortyp,nsccortyp
+ do j=-nsccortyp,nsccortyp
+
+ nterm_sccor(j,i)=nterm_sccor_all(j,i,iparm)
+ do l=1,3
+ do k=1,nterm_sccor(j,i)
+ v1sccor(k,l,j,i)=v1sccor_all(k,l,j,i,iparm)
+ v2sccor(k,l,j,i)=v2sccor_all(k,l,j,i,iparm)
+ enddo
+ enddo
+ enddo
+ enddo
+ return
+ end subroutine restore_parm
+!--------------------------------------------------------------------------
+! make_ensemble1.F
+!--------------------------------------------------------------------------
+ subroutine make_ensembles(islice,*)
+! construct the conformational ensembles at REMD temperatures
+ use geometry_data, only:c
+ use io_base, only:ilen
+ use io_wham, only:pdboutW
+! implicit none
+! include "DIMENSIONS"
+! include "DIMENSIONS.ZSCOPT"
+! include "DIMENSIONS.FREE"
+#ifdef MPI
+ include "mpif.h"
+! include "COMMON.MPI"
+ integer :: ierror,errcode,status(MPI_STATUS_SIZE)
+#endif
+! include "COMMON.IOUNITS"
+! include "COMMON.CONTROL"
+! include "COMMON.FREE"
+! include "COMMON.ENERGIES"
+! include "COMMON.FFIELD"
+! include "COMMON.INTERACT"
+! include "COMMON.SBRIDGE"
+! include "COMMON.CHAIN"
+! include "COMMON.PROTFILES"
+! include "COMMON.PROT"
+ real(kind=4) :: csingle(3,nres*2)
+ real(kind=8),dimension(6) :: fT,fTprim,fTbis
+ real(kind=8) :: quot,quotl1,quotl,kfacl,&
+ eprim,ebis,temper,kfac=2.4d0,T0=300.0d0
+ real(kind=8) :: etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors,&
+ escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,&
+ eello_turn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,tt
+ integer :: i,ii,ik,iproc,iscor,j,k,l,ib,iparm,iprot,nlist
+ real(kind=8) :: qfree,sumprob,eini,efree,rmsdev
+ character(len=80) :: bxname
+ character(len=2) :: licz1,licz2
+ character(len=3) :: licz3,licz4
+ character(len=5) :: ctemper
+!el integer ilen
+!el external ilen
+ real(kind=4) :: Fdimless(MaxStr),Fdimless_(MaxStr)
+ real(kind=8) :: enepot(MaxStr)
+ integer :: iperm(MaxStr)
+ integer :: islice
+ integer,dimension(0:nprocs) :: scount_
+
+#ifdef MPI
+ if (me.eq.Master) then
+#endif
+ write (licz2,'(bz,i2.2)') islice
+ if (nslice.eq.1) then
+ if (.not.separate_parset) then
+ bxname = prefix(:ilen(prefix))//".bx"
+ else
+ write (licz3,'(bz,i3.3)') myparm
+ bxname = prefix(:ilen(prefix))//"_par"//licz3//".bx"
+ endif
+ else
+ if (.not.separate_parset) then
+ bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
+ else
+ write (licz3,'(bz,i3.3)') myparm
+ bxname = prefix(:ilen(prefix))//"par_"//licz3// &
+ "_slice_"//licz2//".bx"
+ endif
+ endif
+ open (ientout,file=bxname,status="unknown",&
+ form="unformatted",access="direct",recl=lenrec1)
+#ifdef MPI
+ endif
+#endif
+ do iparm=1,iparm
+ if (iparm.ne.iparmprint) exit
+ call restore_parm(iparm)
+ do ib=1,nT_h(iparm)
+#ifdef DEBUG
+ write (iout,*) "iparm",iparm," ib",ib
+#endif
+ temper=1.0d0/(beta_h(ib,iparm)*1.987D-3)
+! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3)
+! quotl=1.0d0
+! kfacl=1.0d0
+! do l=1,5
+! quotl1=quotl
+! quotl=quotl*quot
+! kfacl=kfacl*kfac
+! fT(l)=kfacl/(kfacl-1.0d0+quotl)
+! enddo
+!el old rescale weights
+!
+! if (rescale_mode.eq.1) then
+! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3)
+#if defined(FUNCTH)
+ tt=1.0d0/(beta_h(ib,iparm)*1.987D-3)
+ ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/320.0d0
+#elif defined(FUNCT)
+ ft(6)=quot
+#else
+ ft(6)=1.0d0
+#endif
+! quotl=1.0d0
+! kfacl=1.0d0
+! do l=1,5
+! quotl1=quotl
+! quotl=quotl*quot
+! kfacl=kfacl*kfac
+! fT(l)=kfacl/(kfacl-1.0d0+quotl)
+! enddo
+! else if (rescale_mode.eq.2) then
+! quot=1.0d0/(T0*beta_h(ib,iparm)*1.987D-3)
+!#if defined(FUNCTH)
+! tt=1.0d0/(beta_h(ib,iparm)*1.987D-3)
+! ft(6)=(320.0d0+80.0d0*dtanh((tt-320.0d0)/80.0d0))/3200.d0
+!#elif defined(FUNCT)
+! ft(6)=quot
+!#else
+! ft(6)=1.0d0
+!#endif
+! quotl=1.0d0
+! do l=1,5
+! quotl=quotl*quot
+! fT(l)=1.12692801104297249644d0/ &
+! dlog(dexp(quotl)+dexp(-quotl))
+! enddo
+! write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft
+! else if (rescale_mode.eq.0) then
+! do l=1,5
+! fT(l)=0.0d0
+! enddo
+! else
+! write (iout,*) &
+! "Error in MAKE_ENSEMBLE: Wrong RESCALE_MODE:",rescale_mode
+! call flush(iout)
+! return 1
+! endif
+! el end old rescale weihgts
+ call rescale_weights(1.0d0/(beta_h(ib,iparm)*1.987D-3))
+
+#ifdef MPI
+ do i=1,scount(me1)
+#else
+ do i=1,ntot(islice)
+#endif
+ evdw=enetb(1,i,iparm)
+! evdw_t=enetb(21,i,iparm)
+ evdw_t=enetb(20,i,iparm)
+#ifdef SCP14
+! evdw2_14=enetb(17,i,iparm)
+ evdw2_14=enetb(18,i,iparm)
+ evdw2=enetb(2,i,iparm)+evdw2_14
+#else
+ evdw2=enetb(2,i,iparm)
+ evdw2_14=0.0d0
+#endif
+#ifdef SPLITELE
+ ees=enetb(3,i,iparm)
+ evdw1=enetb(16,i,iparm)
+#else
+ ees=enetb(3,i,iparm)
+ evdw1=0.0d0
+#endif
+ ecorr=enetb(4,i,iparm)
+ ecorr5=enetb(5,i,iparm)
+ ecorr6=enetb(6,i,iparm)
+ eel_loc=enetb(7,i,iparm)
+ eello_turn3=enetb(8,i,iparm)
+ eello_turn4=enetb(9,i,iparm)
+ eello_turn6=enetb(10,i,iparm)
+ ebe=enetb(11,i,iparm)
+ escloc=enetb(12,i,iparm)
+ etors=enetb(13,i,iparm)
+ etors_d=enetb(14,i,iparm)
+ ehpb=enetb(15,i,iparm)
+
+ estr=enetb(17,i,iparm)
+! estr=enetb(18,i,iparm)
+! esccor=enetb(19,i,iparm)
+ esccor=enetb(21,i,iparm)
+! edihcnstr=enetb(20,i,iparm)
+ edihcnstr=enetb(19,i,iparm)
+!#ifdef SPLITELE
+! etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees &
+! +wvdwpp*evdw1 &
+! +wang*ebe+ft(1)*wtor*etors+wscloc*escloc &
+! +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 &
+! +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 &
+! +ft(2)*wturn3*eello_turn3 &
+! +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc &
+! +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor &
+! +wbond*estr
+!#else
+! etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 &
+! +ft(1)*welec*(ees+evdw1) &
+! +wang*ebe+ft(1)*wtor*etors+wscloc*escloc &
+! +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 &
+! +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 &
+! +ft(2)*wturn3*eello_turn3 &
+! +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr &
+! +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor &
+! +wbond*estr
+!#endif
+
+#ifdef SPLITELE
+ etot=wsc*evdw+wscp*evdw2+welec*ees &
+ +wvdwpp*evdw1 &
+ +wang*ebe+wtor*etors+wscloc*escloc &
+ +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 &
+ +wcorr6*ecorr6+wturn4*eello_turn4 &
+ +wturn3*eello_turn3 &
+ +wturn6*eello_turn6+wel_loc*eel_loc &
+ +edihcnstr+wtor_d*etors_d+wsccor*esccor &
+ +wbond*estr
+#else
+ etot=wsc*evdw+wscp*evdw2 &
+ +welec*(ees+evdw1) &
+ +wang*ebe+wtor*etors+wscloc*escloc &
+ +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 &
+ +wcorr6*ecorr6+wturn4*eello_turn4 &
+ +wturn3*eello_turn3 &
+ +wturn6*eello_turn6+wel_loc*eel_loc+edihcnstr &
+ +wtor_d*etors_d+wsccor*esccor &
+ +wbond*estr
+#endif
+
+#ifdef MPI
+ Fdimless(i)= &
+ beta_h(ib,iparm)*etot-entfac(i)
+ potE(i,iparm)=etot
+#ifdef DEBUG
+ write (iout,*) i,indstart(me)+i-1,ib,&
+ 1.0d0/(1.987d-3*beta_h(ib,iparm)),potE(i,iparm),&
+ -entfac(i),Fdimless(i)
+#endif
+#else
+ Fdimless(i)=beta_h(ib,iparm)*etot-entfac(i)
+ potE(i,iparm)=etot
+#endif
+ enddo ! i
+#ifdef MPI
+ do i=1,scount(me1)
+ Fdimless_(i)=Fdimless(i)
+ enddo
+ call MPI_Gatherv(Fdimless_(1),scount(me),&
+ MPI_REAL,Fdimless(1),&
+ scount_(0),idispl(0),MPI_REAL,Master,&
+ WHAM_COMM, IERROR)
+#ifdef DEBUG
+ call MPI_Gatherv(potE(1,iparm),scount_(me),&
+ MPI_DOUBLE_PRECISION,potE(1,iparm),&
+ scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master,&
+ WHAM_COMM, IERROR)
+ call MPI_Gatherv(entfac(1),scount(me),&
+ MPI_DOUBLE_PRECISION,entfac(1),&
+ scount_(0),idispl(0),MPI_DOUBLE_PRECISION,Master,&
+ WHAM_COMM, IERROR)
+#endif
+ if (me.eq.Master) then
+#ifdef DEBUG
+ write (iout,*) "The FDIMLESS array before sorting"
+ do i=1,ntot(islice)
+ write (iout,*) i,fdimless(i)
+ enddo
+#endif
+#endif
+ do i=1,ntot(islice)
+ iperm(i)=i
+ enddo
+ call mysort1(ntot(islice),Fdimless,iperm)
+#ifdef DEBUG
+ write (iout,*) "The FDIMLESS array after sorting"
+ do i=1,ntot(islice)
+ write (iout,*) i,iperm(i),fdimless(i)
+ enddo
+#endif
+ qfree=0.0d0
+ do i=1,ntot(islice)
+ qfree=qfree+exp(-fdimless(i)+fdimless(1))
+ enddo
+! write (iout,*) "qfree",qfree
+ nlist=1
+ sumprob=0.0
+ do i=1,min0(ntot(islice),ensembles)
+ sumprob=sumprob+exp(-fdimless(i)+fdimless(1))/qfree
+#ifdef DEBUG
+ write (iout,*) i,ib,beta_h(ib,iparm),&
+ 1.0d0/(1.987d-3*beta_h(ib,iparm)),iperm(i),&
+ potE(iperm(i),iparm),&
+ -entfac(iperm(i)),fdimless(i),sumprob
+#endif
+ if (sumprob.gt.0.99d0) goto 122
+ nlist=nlist+1
+ enddo
+ 122 continue
+#ifdef MPI
+ endif
+ call MPI_Bcast(nlist, 1, MPI_INTEGER, Master, WHAM_COMM,&
+ IERROR)
+ call MPI_Bcast(iperm,nlist,MPI_INTEGER,Master,WHAM_COMM,&
+ IERROR)
+ do i=1,nlist
+ ii=iperm(i)
+ iproc=0
+ do while (ii.lt.indstart(iproc).or.ii.gt.indend(iproc))
+ iproc=iproc+1
+ enddo
+ if (iproc.ge.nprocs) then
+ write (iout,*) "Fatal error: processor out of range",iproc
+ call flush(iout)
+ if (bxfile) then
+ close (ientout)
+ else
+ close (ientout,status="delete")
+ endif
+ return 1
+ endif
+ ik=ii-indstart(iproc)+1
+ if (iproc.ne.Master) then
+ if (me.eq.iproc) then
+#ifdef DEBUG
+ write (iout,*) "i",i," ii",ii," iproc",iproc," ik",ik,&
+ " energy",potE(ik,iparm)
+#endif
+ call MPI_Send(potE(ik,iparm),1,MPI_DOUBLE_PRECISION,&
+ Master,i,WHAM_COMM,IERROR)
+ else if (me.eq.Master) then
+ call MPI_Recv(enepot(i),1,MPI_DOUBLE_PRECISION,iproc,i,&
+ WHAM_COMM,STATUS,IERROR)
+ endif
+ else if (me.eq.Master) then
+ enepot(i)=potE(ik,iparm)
+ endif
+ enddo
+#else
+ do i=1,nlist
+ enepot(i)=potE(iperm(i),iparm)
+ enddo
+#endif
+#ifdef MPI
+ if (me.eq.Master) then
+#endif
+ write(licz3,'(bz,i3.3)') iparm
+ write(licz2,'(bz,i2.2)') islice
+ if (temper.lt.100.0d0) then
+ write(ctemper,'(f3.0)') temper
+ else if (temper.lt.1000.0) then
+ write (ctemper,'(f4.0)') temper
+ else
+ write (ctemper,'(f5.0)') temper
+ endif
+ if (nparmset.eq.1) then
+ if (separate_parset) then
+ write(licz4,'(bz,i3.3)') myparm
+ pdbname=prefix(:ilen(prefix))//"_par"//licz4
+ else
+ pdbname=prefix(:ilen(prefix))
+ endif
+ else
+ pdbname=prefix(:ilen(prefix))//"_parm_"//licz3
+ endif
+ if (nslice.eq.1) then
+ pdbname=pdbname(:ilen(pdbname))//"_T_"// &
+ ctemper(:ilen(ctemper))//"pdb"
+ else
+ pdbname=pdbname(:ilen(pdbname))//"_slice_"//licz2//"_T_"// &
+ ctemper(:ilen(ctemper))//"pdb"
+ endif
+ open(ipdb,file=pdbname)
+ do i=1,nlist
+ read (ientout,rec=iperm(i)) &
+ ((csingle(l,k),l=1,3),k=1,nres),&
+ ((csingle(l,k+nres),l=1,3),k=nnt,nct),&
+ nss,(ihpb(k),jhpb(k),k=1,nss),&
+ eini,efree,rmsdev,iscor
+ do j=1,2*nres
+ do k=1,3
+ c(k,j)=csingle(k,j)
+ enddo
+ enddo
+ eini=fdimless(i)
+ call pdboutW(iperm(i),temper,eini,enepot(i),efree,rmsdev)
+ enddo
+#ifdef MPI
+ endif
+#endif
+ enddo ! ib
+ enddo ! iparm
+ if (bxfile) then
+ close(ientout)
+ else
+ close(ientout,status="delete")
+ endif
+ do i=0,nprocs
+ scount(i)=scount_(i)
+ enddo
+ return
+ end subroutine make_ensembles
+!--------------------------------------------------------------------------
+ subroutine mysort1(n, x, ipermut)
+! implicit none
+ integer :: i,j,imax,ipm,n
+ real(kind=4) :: x(n)
+ integer :: ipermut(n)
+ real(kind=4) :: xtemp
+ do i=1,n
+ xtemp=x(i)
+ imax=i
+ do j=i+1,n
+ if (x(j).lt.xtemp) then
+ imax=j
+ xtemp=x(j)
+ endif
+ enddo
+ x(imax)=x(i)
+ x(i)=xtemp
+ ipm=ipermut(imax)
+ ipermut(imax)=ipermut(i)
+ ipermut(i)=ipm
+ enddo
+ return
+ end subroutine mysort1
+!--------------------------------------------------------------------------
+ subroutine alloc_enecalc_arrays(iparm)
+
+ use control_data
+ use geometry_data, only:maxlob
+ integer :: iparm
+!---------------------------
+! COMMON.ENERGIES form wham_data
+! common /energies/
+ allocate(potE(MaxStr_Proc,iparm)) !(MaxStr_Proc,Max_Parm)
+ allocate(entfac(MaxStr_Proc)) !(MaxStr_Proc)
+ allocate(q(nQ+2,MaxStr_Proc)) !(MaxQ+2,MaxStr_Proc)
+ allocate(enetb(max_ene,MaxStr_Proc,iparm)) !(max_ene,MaxStr_Proc,Max_Parm)
+!
+! allocate ENECALC arrays
+!---------------------------
+! COMMON.ALLPARM
+! common /allparm/
+ allocate(ww_all(max_eneW,iparm)) !(max_ene,max_parm) ! max_eneW
+ allocate(vbldp0_all(iparm),akp_all(nParmSet)) !(max_parm)
+ allocate(vbldsc0_all(maxbondterm,ntyp,iparm),&
+ aksc_all(maxbondterm,ntyp,iparm),&
+ abond0_all(maxbondterm,ntyp,iparm)) !(maxbondterm,ntyp,max_parm)
+ allocate(a0thet_all(-ntyp:ntyp,iparm)) !(-ntyp:ntyp,max_parm)
+ allocate(athet_all(2,-ntyp:ntyp,-1:1,-1:1,iparm),&
+ bthet_all(2,-ntyp:ntyp,-1:1,-1:1,iparm)) !(2,-ntyp:ntyp,-1:1,-1:1,max_parm)
+ allocate(polthet_all(0:3,-ntyp:ntyp,iparm)) !(0:3,-ntyp:ntyp,max_parm)
+ allocate(gthet_all(3,-ntyp:ntyp,iparm)) !(3,-ntyp:ntyp,max_parm)
+ allocate(theta0_all(-ntyp:ntyp,iparm),&
+ sig0_all(-ntyp:ntyp,iparm),sigc0_all(-ntyp:ntyp,nParmSet)) !(-ntyp:ntyp,max_parm)
+ allocate(aa0thet_all(-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm))
+!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm)
+ allocate(aathet_all(maxtheterm,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm))
+!(maxtheterm,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm)
+ allocate(bbthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm))
+ allocate(ccthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm))
+ allocate(ddthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm))
+ allocate(eethet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,iparm))
+!(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,
+! & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm)
+ allocate(ffthet_all1(maxdouble,maxdouble,maxtheterm3,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,iparm))
+ allocate(ggthet_all1(maxdouble,maxdouble,maxtheterm3,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,iparm))
+ allocate(ffthet_all2(maxdouble,maxdouble,maxtheterm3,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,iparm))
+ allocate(ggthet_all2(maxdouble,maxdouble,maxtheterm3,&
+ -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,&
+ -maxthetyp1:maxthetyp1,iparm))
+!(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,&
+!-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,max_parm)
+ allocate(dsc_all(ntyp1,iparm),dsc0_all(ntyp1,nParmSet)) !(ntyp1,max_parm)
+ allocate(bsc_all(maxlob,ntyp,iparm))
+!(maxlob,ntyp,max_parm)
+ allocate(censc_all(3,maxlob,-ntyp:ntyp,iparm)) !(3,maxlob,-ntyp:ntyp,max_parm)
+ allocate(gaussc_all(3,3,maxlob,-ntyp:ntyp,iparm)) !(3,3,maxlob,-ntyp:ntyp,max_parm)
+ allocate(sc_parmin_all(65,ntyp,iparm)) !(65,ntyp,max_parm)
+ allocate(v0_all(-maxtor:maxtor,-maxtor:maxtor,2,iparm))
+!(-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(v1_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,iparm))
+ allocate(v2_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,iparm))
+!(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(vlor1_all(maxlor,maxtor,maxtor,iparm))
+ allocate(vlor2_all(maxlor,maxtor,maxtor,iparm))
+ allocate(vlor3_all(maxlor,maxtor,maxtor,iparm)) !(maxlor,maxtor,maxtor,max_parm)
+ allocate(v1c_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,&
+ -maxtor:maxtor,2,iparm))
+ allocate(v1s_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,&
+ -maxtor:maxtor,2,iparm))
+!(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(v2c_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,&
+ -maxtor:maxtor,-maxtor:maxtor,2,iparm))
+!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(v2s_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,&
+ -maxtor:maxtor,-maxtor:maxtor,2,iparm))
+!(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(b1_all(2,-maxtor:maxtor,iparm))
+ allocate(b2_all(2,-maxtor:maxtor,iparm)) !(2,-maxtor:maxtor,max_parm)
+ allocate(cc_all(2,2,-maxtor:maxtor,iparm))
+ allocate(dd_all(2,2,-maxtor:maxtor,iparm))
+ allocate(ee_all(2,2,-maxtor:maxtor,iparm)) !(2,2,-maxtor:maxtor,max_parm)
+ allocate(ctilde_all(2,2,-maxtor:maxtor,iparm))
+ allocate(dtilde_all(2,2,-maxtor:maxtor,iparm)) !(2,2,-maxtor:maxtor,max_parm)
+ allocate(b1tilde_all(2,-maxtor:maxtor,iparm)) !(2,-maxtor:maxtor,max_parm)
+ allocate(app_all(2,2,iparm),bpp_all(2,2,nParmSet),&
+ ael6_all(2,2,iparm),ael3_all(2,2,nParmSet)) !(2,2,max_parm)
+ allocate(aad_all(ntyp,2,iparm),bad_all(ntyp,2,nParmSet)) !(ntyp,2,max_parm)
+ allocate(aa_all(ntyp,ntyp,iparm),bb_all(ntyp,ntyp,nParmSet),&
+ augm_all(ntyp,ntyp,iparm),eps_all(ntyp,ntyp,nParmSet),&
+ sigma_all(ntyp,ntyp,iparm),r0_all(ntyp,ntyp,nParmSet),&
+ chi_all(ntyp,ntyp,iparm)) !(ntyp,ntyp,max_parm)
+ allocate(chip_all(ntyp,iparm),alp_all(ntyp,nParmSet)) !(ntyp,max_parm)
+ allocate(ebr_all(iparm),d0cm_all(nParmSet),akcm_all(nParmSet),&
+ akth_all(iparm),akct_all(nParmSet),v1ss_all(nParmSet),&
+ v2ss_all(iparm),v3ss_all(nParmSet)) !(max_parm)
+ allocate(v1sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,iparm))
+ allocate(v2sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,iparm))
+!(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm)
+ allocate(nlob_all(ntyp1,iparm)) !(ntyp1,max_parm)
+ allocate(nlor_all(-maxtor:maxtor,-maxtor:maxtor,2,iparm))
+ allocate(nterm_all(-maxtor:maxtor,-maxtor:maxtor,2,iparm))
+!(-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(ntermd1_all(-maxtor:maxtor,-maxtor:maxtor,&
+ -maxtor:maxtor,2,iparm))
+ allocate(ntermd2_all(-maxtor:maxtor,-maxtor:maxtor,&
+ -maxtor:maxtor,2,iparm))
+!(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2,max_parm)
+ allocate(nbondterm_all(ntyp,iparm)) !(ntyp,max_parm)
+ allocate(ithetyp_all(-ntyp1:ntyp1,iparm)) !(-ntyp1:ntyp1,max_parm)
+ allocate(nthetyp_all(iparm),ntheterm_all(nParmSet),&
+ ntheterm2_all(iparm),ntheterm3_all(nParmSet),&
+ nsingle_all(iparm),&
+ ndouble_all(iparm),nntheterm_all(nParmSet)) !(max_parm)
+ allocate(nterm_sccor_all(-ntyp:ntyp,-ntyp:ntyp,iparm)) !(-ntyp:ntyp,-ntyp:ntyp,max_parm)
+!
+ end subroutine alloc_enecalc_arrays
+!--------------------------------------------------------------------------
+!--------------------------------------------------------------------------
+ end module ene_calc
projects / unres4.git / blobdiff