+++ /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