block data
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.MCM'
- include 'COMMON.MD'
+#ifdef LANG0
+#ifdef FIVEDIAG
+ include 'COMMON.LANGEVIN.lang0.5diag'
+#else
+ include 'COMMON.LANGEVIN.lang0'
+#endif
+#else
+ include 'COMMON.LANGEVIN'
+#endif
data MovTypID
& /'pool','chain regrow','multi-bond','phi','theta','side chain',
& 'total'/
C
C Define constants and zero out tables.
C
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.MINIM'
include 'COMMON.DERIV'
include 'COMMON.SPLITELE'
+ include 'COMMON.VAR'
+ include 'COMMON.MD'
c Common blocks from the diagonalization routines
+ integer IR,IW,IP,IJK,IPK,IDAF,NAV,IODA,KDIAG,ICORFL,IXDR
+ integer i,idumm,j,k,l,ichir1,ichir2,iblock,m
+ double precision rr
COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- logical mask_r
c real*8 text1 /'initial_i'/
mask_r=.false.
+ mask_theta=1
+ mask_phi=1
+ mask_side=1
#ifndef ISNAN
c NaNQ initialization
i=-1
call proc_proc(rr,i)
#endif
#endif
-
+ itime_mat=0.
kdiag=0
icorfl=0
iw=2
C lipidic environment if lipid is implicite
C DNA input files for parameters range 80-99
-C Suger input files for parameters range 100-119
+C Sugar input files for parameters range 100-119
C All-atom input files for parameters range 120-149
C
C Set default weights of the energy terms.
C
- wlong=1.0D0
+ wsc=1.0D0
welec=1.0D0
wtor =1.0D0
wang =1.0D0
ns=0
nss=0
nhpb=0
- do i=1,maxss
+ do i=1,max_cyst
iss(i)=0
enddo
- do i=1,maxdim
+ do i=1,maxdim_cont
dhpb(i)=0.0D0
enddo
do i=1,maxres
C
c maxfun=5000
c maxit=2000
- maxfun=500
- maxit=200
+ maxfun=1000
+ maxmin=500
tolf=1.0D-2
rtolf=5.0D-4
C
C
nfl=0
icg=1
+ sideonly=.false.
C
C Initialize constants used to split the energy into long- and short-range
C components
end
c-------------------------------------------------------------------------
block data nazwy
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.NAMES'
include 'COMMON.FFIELD'
1 "WSC ","WSCP ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
! 8 9 10 11 12 13 14
8 "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR ","WTORD ",
-! 15 16 17 18 19 20 21
+!? 15 16 17 18 19 20 21
5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR",
! 22 23 24 25 26 27 28
2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD",
end
c---------------------------------------------------------------------------
subroutine init_int_table
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
+ integer ierr,ierror
integer blocklengths(15),displs(15)
#endif
include 'COMMON.CONTROL'
+ include 'COMMON.SAXS'
include 'COMMON.SETUP'
include 'COMMON.CHAIN'
include 'COMMON.INTERACT'
include 'COMMON.TORCNSTR'
include 'COMMON.IOUNITS'
include 'COMMON.DERIV'
- include 'COMMON.CONTACTS'
+#ifdef FOURBODY
+ include 'COMMON.CONTMAT'
+#endif
+ include 'COMMON.CORRMAT'
+ integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
+ & iturn4_end_all,iatel_s_all,
+ & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
+ & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all
+ integer*8 n_sc_int_tot,my_sc_inds,my_sc_inde,ind_scint,
+ & ind_scint_old,nele_int_tot,ind_eleint,my_ele_inds,my_ele_inde,
+ & ind_eleint_old,nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw,
+ & ind_eleint_vdw,ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,
+ & my_scp_inde,ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,
+ & ngrad_end
common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
& iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
& iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
& itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
logical scheck,lprint,flag
+ integer i,j,k,ii,jj,iint,npept,
+ & ijunk,iaux,ind_typ,ncheck_from,ncheck_to,ichunk
#ifdef MPI
integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
& my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
C... Determine the numbers of start and end SC-SC interaction
C... to deal with by current processor.
+#ifdef FOURBODY
do i=0,nfgtasks-1
itask_cont_from(i)=fg_rank
itask_cont_to(i)=fg_rank
enddo
+#endif
lprint=energy_dec
if (lprint)
&write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
- n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
- call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
+ n_sc_int_tot=int(nct-nnt+1,8)*int(nct-nnt,8)/2-nss
+ call int_bounds8(n_sc_int_tot,my_sc_inds,my_sc_inde)
if (lprint)
& write (iout,*) 'Processor',fg_rank,' CG group',kolor,
& ' absolute rank',MyRank,
& ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
& ' my_sc_inde',my_sc_inde
- ind_sctint=0
+ ind_scint=0
iatsc_s=0
iatsc_e=0
#endif
if (jj.eq.i+1) then
#ifdef MPI
c write (iout,*) 'jj=i+1'
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
+ call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
& iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
#else
nint_gr(i)=1
else if (jj.eq.nct) then
#ifdef MPI
c write (iout,*) 'jj=nct'
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
+ call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
& iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
#else
nint_gr(i)=1
#endif
else
#ifdef MPI
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
+ call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
& iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
ii=nint_gr(i)+1
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
+ call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
& iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
#else
nint_gr(i)=2
endif
else
#ifdef MPI
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
+ call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
& iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
#else
nint_gr(i)=1
& ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
#endif
if (lprint) then
+ write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
write (iout,'(a)') 'Interaction array:'
do i=iatsc_s,iatsc_e
- write (iout,'(i3,2(2x,2i3))')
+ write (iout,'(i7,2(2x,2i7))')
& i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
enddo
endif
#ifdef MPI
C Now partition the electrostatic-interaction array
npept=nct-nnt
- nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
- call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
+ nele_int_tot=int(npept-ispp,8)*int(npept-ispp+1,8)/2
+ call int_bounds8(nele_int_tot,my_ele_inds,my_ele_inde)
if (lprint)
& write (*,*) 'Processor',fg_rank,' CG group',kolor,
& ' absolute rank',MyRank,
ind_eleint_old=0
do i=nnt,nct-3
ijunk=0
- call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
+ call int_partition8(ind_eleint,my_ele_inds,my_ele_inde,i,
& iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
enddo ! i
13 continue
if (iatel_s.eq.0) iatel_s=1
- nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
+ nele_int_tot_vdw=int(npept-2,8)*int(npept-2+1,8)/2
c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
- call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
+ call int_bounds8(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
c & " my_ele_inde_vdw",my_ele_inde_vdw
ind_eleint_vdw=0
iatel_e_vdw=0
do i=nnt,nct-3
ijunk=0
- call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
+ call int_partition8(ind_eleint_vdw,my_ele_inds_vdw,
& my_ele_inde_vdw,i,
& iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
& ielend_vdw(i),*15)
& ' absolute rank',MyRank
write (iout,*) 'Electrostatic interaction array:'
do i=iatel_s,iatel_e
- write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
+ write (iout,'(i7,2(2x,2i7))') i,ielstart(i),ielend(i)
enddo
endif ! lprint
c iscp=3
iscp=2
C Partition the SC-p interaction array
#ifdef MPI
- nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
- call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
+ nscp_int_tot=int(npept-iscp+1,8)*int(npept-iscp+1,8)
+ call int_bounds8(nscp_int_tot,my_scp_inds,my_scp_inde)
if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
& ' absolute rank',myrank,
& ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
do i=nnt,nct-1
if (i.lt.nnt+iscp) then
cd write (iout,*) 'i.le.nnt+iscp'
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
+ call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
& iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
& iscpend(i,1),*14)
else if (i.gt.nct-iscp) then
cd write (iout,*) 'i.gt.nct-iscp'
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
+ call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
& iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
& iscpend(i,1),*14)
else
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
+ call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
& iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
& iscpend(i,1),*14)
ii=nscp_gr(i)+1
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
+ call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
& iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
& iscpend(i,ii),*14)
endif
if (lprint) then
write (iout,'(a)') 'SC-p interaction array:'
do i=iatscp_s,iatscp_e
- write (iout,'(i3,2(2x,2i3))')
+ write (iout,'(i7,2(2x,2i7))')
& i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
enddo
endif ! lprint
endif
c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
c nlen=nres-nnt+1
- nsumgrad=(nres-nnt)*(nres-nnt+1)/2
- nlen=nres-nnt+1
- call int_bounds(nsumgrad,ngrad_start,ngrad_end)
- igrad_start=((2*nlen+1)
- & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
- jgrad_start(igrad_start)=
- & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
- & +igrad_start
- jgrad_end(igrad_start)=nres
- igrad_end=((2*nlen+1)
- & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
- if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
- jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
- & +igrad_end
- do i=igrad_start+1,igrad_end-1
- jgrad_start(i)=i+1
- jgrad_end(i)=nres
- enddo
+c nsumgrad=(nres-nnt)*(nres-nnt+1)/2
+c nlen=nres-nnt+1
+c call int_bounds(nsumgrad,ngrad_start,ngrad_end)
+c igrad_start=((2*nlen+1)
+c & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
+c jgrad_start(igrad_start)=
+c & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
+c & +igrad_start
+c jgrad_end(igrad_start)=nres
+c igrad_end=((2*nlen+1)
+c & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
+c if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
+c jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
+c & +igrad_end
+c do i=igrad_start+1,igrad_end-1
+c jgrad_start(i)=i+1
+c jgrad_end(i)=nres
+c enddo
if (lprint) then
write (*,*) 'Processor:',fg_rank,' CG group',kolor,
& ' absolute rank',myrank,
& ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
& ithetaconstr_end
- write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
- & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
- & ' ngrad_end',ngrad_end
- do i=igrad_start,igrad_end
- write(*,*) 'Processor:',fg_rank,myrank,i,
- & jgrad_start(i),jgrad_end(i)
- enddo
+c write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
+c & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
+c & ' ngrad_end',ngrad_end
+c do i=igrad_start,igrad_end
+c write(*,*) 'Processor:',fg_rank,myrank,i,
+c & jgrad_start(i),jgrad_end(i)
+c enddo
endif
if (nfgtasks.gt.1) then
call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
enddo
call flush(iout)
endif
+#ifdef FOURBODY
ntask_cont_from=0
ntask_cont_to=0
itask_cont_from(0)=fg_rank
call MPI_Group_free(fg_group,ierr)
call MPI_Group_free(cont_from_group,ierr)
call MPI_Group_free(cont_to_group,ierr)
+#endif
call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
call MPI_Type_commit(MPI_UYZ,IERROR)
call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
end
c---------------------------------------------------------------------------
subroutine int_bounds(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.SETUP'
integer total_ints,lower_bound,upper_bound
integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
+ integer i,nint,nexcess
+ nint=total_ints/nfgtasks
+ do i=1,nfgtasks
+ int4proc(i-1)=nint
+ enddo
+ nexcess=total_ints-nint*nfgtasks
+ do i=1,nexcess
+ int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
+ enddo
+ lower_bound=0
+ do i=0,fg_rank-1
+ lower_bound=lower_bound+int4proc(i)
+ enddo
+ upper_bound=lower_bound+int4proc(fg_rank)
+ lower_bound=lower_bound+1
+ return
+ end
+c---------------------------------------------------------------------------
+ subroutine int_bounds8(total_ints,lower_bound,upper_bound)
+ implicit none
+ include 'DIMENSIONS'
+ include 'mpif.h'
+ include 'COMMON.SETUP'
+ integer*8 total_ints,lower_bound,upper_bound,nint
+ integer*8 int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
+ integer i,nexcess
nint=total_ints/nfgtasks
do i=1,nfgtasks
int4proc(i-1)=nint
end
c---------------------------------------------------------------------------
subroutine int_bounds1(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'mpif.h'
include 'COMMON.SETUP'
integer total_ints,lower_bound,upper_bound
integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
+ integer i,nint,nexcess
nint=total_ints/nfgtasks1
do i=1,nfgtasks1
int4proc(i-1)=nint
c---------------------------------------------------------------------------
subroutine int_partition(int_index,lower_index,upper_index,atom,
& at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
include 'COMMON.IOUNITS'
integer int_index,lower_index,upper_index,atom,at_start,at_end,
- & first_atom,last_atom,int_gr,jat_start,jat_end
+ & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
+ logical lprn
+ lprn=.false.
+ if (lprn) write (iout,*) 'int_index=',int_index
+ int_index_old=int_index
+ int_index=int_index+last_atom-first_atom+1
+ if (lprn)
+ & write (iout,*) 'int_index=',int_index,
+ & ' int_index_old',int_index_old,
+ & ' lower_index=',lower_index,
+ & ' upper_index=',upper_index,
+ & ' atom=',atom,' first_atom=',first_atom,
+ & ' last_atom=',last_atom
+ if (int_index.ge.lower_index) then
+ int_gr=int_gr+1
+ if (at_start.eq.0) then
+ at_start=atom
+ jat_start=first_atom-1+lower_index-int_index_old
+ else
+ jat_start=first_atom
+ endif
+ if (lprn) write (iout,*) 'jat_start',jat_start
+ if (int_index.ge.upper_index) then
+ at_end=atom
+ jat_end=first_atom-1+upper_index-int_index_old
+ return1
+ else
+ jat_end=last_atom
+ endif
+ if (lprn) write (iout,*) 'jat_end',jat_end
+ endif
+ return
+ end
+c---------------------------------------------------------------------------
+ subroutine int_partition8(int_index,lower_index,upper_index,atom,
+ & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
+ implicit none
+ include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
+ integer*8 int_index,lower_index,upper_index
+ integer atom,at_start,at_end,
+ & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
logical lprn
lprn=.false.
if (lprn) write (iout,*) 'int_index=',int_index
#endif
c------------------------------------------------------------------------------
subroutine hpb_partition
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
end
c------------------------------------------------------------------------------
subroutine homology_partition
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
include 'COMMON.IOUNITS'
include 'COMMON.SETUP'
include 'COMMON.CONTROL'
- include 'COMMON.MD'
include 'COMMON.INTERACT'
+ include 'COMMON.HOMOLOGY'
cd write(iout,*)"homology_partition: lim_odl=",lim_odl,
cd & " lim_dih",lim_dih
#ifdef MPI
end
c------------------------------------------------------------------------------
subroutine NMRpeak_partition
- implicit real*8 (a-h,o-z)
+ implicit none
include 'DIMENSIONS'
#ifdef MPI
include 'mpif.h'
projects / unres.git / blobdiff