--- /dev/null
+ module control_wham
+!-----------------------------------------------------------------------------
+
+ implicit none
+!-----------------------------------------------------------------------------
+!
+!
+!-----------------------------------------------------------------------------
+ contains
+!-----------------------------------------------------------------------------
+! initialize_p.F
+!-----------------------------------------------------------------------------
+ subroutine init_int_table
+! implicit real*8 (a-h,o-z)
+! include 'DIMENSIONS'
+! include 'DIMENSIONS.ZSCOPT'
+#ifdef MPI
+ use MPI_data
+ include 'mpif.h'
+#endif
+#ifdef MP
+! include 'COMMON.INFO'
+#endif
+! include 'COMMON.CHAIN'
+! include 'COMMON.INTERACT'
+! include 'COMMON.LOCAL'
+! include 'COMMON.SBRIDGE'
+! include 'COMMON.IOUNITS'
+ logical :: scheck,lprint
+#ifdef MPI
+ integer :: my_sc_int(0:nfgtasks-1),my_ele_int(0:nfgtasks-1)
+ integer :: my_sc_intt(0:nfgtasks),my_ele_intt(0:nfgtasks)
+
+!... Determine the numbers of start and end SC-SC interaction
+!... to deal with by current processor.
+ lprint=.true.
+ if (lprint) &
+ write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
+ n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
+ MyRank=MyID-(MyGroup-1)*fgProcs
+ call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
+ if (lprint) &
+ write (iout,*) 'Processor',MyID,' MyRank',MyRank,&
+ ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,&
+ ' my_sc_inde',my_sc_inde
+ ind_sctint=0
+ iatsc_s=0
+ iatsc_e=0
+#endif
+ lprint=.false.
+! do i=1,maxres !el ?????????
+ do i=1,nres
+ nint_gr(i)=0
+ nscp_gr(i)=0
+ do j=1,maxint_gr
+ istart(i,1)=0
+ iend(i,1)=0
+ ielstart(i)=0
+ ielend(i)=0
+ iscpstart(i,1)=0
+ iscpend(i,1)=0
+ enddo
+ enddo
+ ind_scint=0
+ ind_scint_old=0
+!d write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
+!d & (ihpb(i),jhpb(i),i=1,nss)
+ do i=nnt,nct-1
+ scheck=.false.
+ do ii=1,nss
+ if (ihpb(ii).eq.i+nres) then
+ scheck=.true.
+ jj=jhpb(ii)-nres
+ goto 10
+ endif
+ enddo
+ 10 continue
+!d write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
+ if (scheck) then
+ if (jj.eq.i+1) then
+#ifdef MPI
+ write (iout,*) 'jj=i+1'
+ call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
+ iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
+#else
+ nint_gr(i)=1
+ istart(i,1)=i+2
+ iend(i,1)=nct
+#endif
+ else if (jj.eq.nct) then
+#ifdef MPI
+ write (iout,*) 'jj=nct'
+ call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
+ iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
+#else
+ nint_gr(i)=1
+ istart(i,1)=i+1
+ iend(i,1)=nct-1
+#endif
+ else
+#ifdef MPI
+ call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
+ iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
+ ii=nint_gr(i)+1
+ call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
+ iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
+#else
+ nint_gr(i)=2
+ istart(i,1)=i+1
+ iend(i,1)=jj-1
+ istart(i,2)=jj+1
+ iend(i,2)=nct
+#endif
+ endif
+ else
+#ifdef MPI
+ call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
+ iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
+#else
+ nint_gr(i)=1
+ istart(i,1)=i+1
+ iend(i,1)=nct
+ ind_scint=int_scint+nct-i
+#endif
+ endif
+#ifdef MPI
+ ind_scint_old=ind_scint
+#endif
+ enddo
+ 12 continue
+#ifndef MPI
+ iatsc_s=nnt
+ iatsc_e=nct-1
+#endif
+#ifdef MPI
+ if (lprint) then
+ write (iout,*) 'Processor',MyID,' Group',MyGroup
+ write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
+ endif
+#endif
+ if (lprint) then
+ write (iout,'(a)') 'Interaction array:'
+ do i=iatsc_s,iatsc_e
+ write (iout,'(i3,2(2x,2i3))') &
+ i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
+ enddo
+ endif
+ ispp=2
+#ifdef MPI
+! Now partition the electrostatic-interaction array
+ npept=nct-nnt
+ nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
+ call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
+ if (lprint) &
+ write (iout,*) 'Processor',MyID,' MyRank',MyRank,&
+ ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,&
+ ' my_ele_inde',my_ele_inde
+ iatel_s=0
+ iatel_e=0
+ ind_eleint=0
+ ind_eleint_old=0
+ do i=nnt,nct-3
+ ijunk=0
+ call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,&
+ iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
+ enddo ! i
+ 13 continue
+#else
+ iatel_s=nnt
+ iatel_e=nct-3
+ do i=iatel_s,iatel_e
+ ielstart(i)=i+2
+ ielend(i)=nct-1
+ enddo
+#endif
+ if (lprint) then
+ write (iout,'(a)') 'Electrostatic interaction array:'
+ do i=iatel_s,iatel_e
+ write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
+ enddo
+ endif ! lprint
+! iscp=3
+ iscp=2
+! Partition the SC-p interaction array
+#ifdef MPI
+ nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
+ call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
+ if (lprint) &
+ write (iout,*) 'Processor',MyID,' MyRank',MyRank,&
+ ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,&
+ ' my_scp_inde',my_scp_inde
+ iatscp_s=0
+ iatscp_e=0
+ ind_scpint=0
+ ind_scpint_old=0
+ do i=nnt,nct-1
+ if (i.lt.nnt+iscp) then
+!d write (iout,*) 'i.le.nnt+iscp'
+ call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
+ iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),&
+ iscpend(i,1),*14)
+ else if (i.gt.nct-iscp) then
+!d write (iout,*) 'i.gt.nct-iscp'
+ call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
+ iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),&
+ iscpend(i,1),*14)
+ else
+ call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
+ iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),&
+ iscpend(i,1),*14)
+ ii=nscp_gr(i)+1
+ call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
+ iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),&
+ iscpend(i,ii),*14)
+ endif
+ enddo ! i
+ 14 continue
+#else
+ iatscp_s=nnt
+ iatscp_e=nct-1
+ do i=nnt,nct-1
+ if (i.lt.nnt+iscp) then
+ nscp_gr(i)=1
+ iscpstart(i,1)=i+iscp
+ iscpend(i,1)=nct
+ elseif (i.gt.nct-iscp) then
+ nscp_gr(i)=1
+ iscpstart(i,1)=nnt
+ iscpend(i,1)=i-iscp
+ else
+ nscp_gr(i)=2
+ iscpstart(i,1)=nnt
+ iscpend(i,1)=i-iscp
+ iscpstart(i,2)=i+iscp
+ iscpend(i,2)=nct
+ endif
+ enddo ! i
+#endif
+ if (lprint) then
+ write (iout,'(a)') 'SC-p interaction array:'
+ do i=iatscp_s,iatscp_e
+ write (iout,'(i3,2(2x,2i3))') &
+ i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
+ enddo
+ endif ! lprint
+! Partition local interactions
+#ifdef MPI
+ call int_bounds(nres-2,loc_start,loc_end)
+ loc_start=loc_start+1
+ loc_end=loc_end+1
+ call int_bounds(nres-2,ithet_start,ithet_end)
+ ithet_start=ithet_start+2
+ ithet_end=ithet_end+2
+ call int_bounds(nct-nnt-2,iphi_start,iphi_end)
+ iphi_start=iphi_start+nnt+2
+ iphi_end=iphi_end+nnt+2
+ call int_bounds(nres-3,itau_start,itau_end)
+ itau_start=itau_start+3
+ itau_end=itau_end+3
+ if (lprint) then
+ write (iout,*) 'Processor:',MyID,&
+ ' loc_start',loc_start,' loc_end',loc_end,&
+ ' ithet_start',ithet_start,' ithet_end',ithet_end,&
+ ' iphi_start',iphi_start,' iphi_end',iphi_end
+ write (*,*) 'Processor:',MyID,&
+ ' loc_start',loc_start,' loc_end',loc_end,&
+ ' ithet_start',ithet_start,' ithet_end',ithet_end,&
+ ' iphi_start',iphi_start,' iphi_end',iphi_end
+ endif
+ if (fgprocs.gt.1 .and. MyID.eq.BossID) then
+ write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',&
+ nele_int_tot,' electrostatic and ',nscp_int_tot,&
+ ' SC-p interactions','were distributed among',fgprocs,&
+ ' fine-grain processors.'
+ endif
+#else
+ loc_start=2
+ loc_end=nres-1
+ ithet_start=3
+ ithet_end=nres
+ iphi_start=nnt+3
+ iphi_end=nct
+ itau_start=4
+ itau_end=nres
+#endif
+ return
+ end subroutine init_int_table
+!-----------------------------------------------------------------------------
+!-----------------------------------------------------------------------------
+ end module control_wham
projects / unres4.git / blobdiff