X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fcontrol_wham.F90;fp=source%2Fwham%2Fcontrol_wham.F90;h=2000e0b056007a8b1c3a4afbdc43be0b49240366;hb=2611e37f82b576a1366c2d78fce87c1a55852037;hp=0000000000000000000000000000000000000000;hpb=a1e9d5a6b704c90ebd10f86a655780212a880dce;p=unres4.git

diff --git a/source/wham/control_wham.F90 b/source/wham/control_wham.F90
new file mode 100644
index 0000000..2000e0b
--- /dev/null
+++ b/source/wham/control_wham.F90
@@ -0,0 +1,290 @@
+      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