Adam's unres update
[unres.git] / source / unres / src-HCD-5D / initialize_p.F
index 710f907..6a297b8 100644 (file)
@@ -351,7 +351,7 @@ c-------------------------------------------------------------------------
      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",
@@ -453,8 +453,13 @@ c---------------------------------------------------------------------------
       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,
-     & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old
+     & 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),
@@ -466,12 +471,8 @@ c---------------------------------------------------------------------------
      & 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,nele_int_tot,ind_eleint,ind_scint,
-     & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw,
-     & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk,
-     & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde,
-     & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,
-     & iaux,ind_typ,ncheck_from,ncheck_to,ichunk
+      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)
@@ -486,14 +487,14 @@ C... to deal with by current processor.
       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
@@ -530,7 +531,7 @@ cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
           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
@@ -540,7 +541,7 @@ c            write (iout,*) 'jj=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
@@ -549,10 +550,10 @@ c            write (iout,*) 'jj=nct'
 #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
@@ -564,7 +565,7 @@ c            write (iout,*) 'jj=nct'
           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
@@ -588,9 +589,10 @@ c            write (iout,*) 'jj=nct'
      &   ' 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
@@ -598,8 +600,8 @@ c            write (iout,*) 'jj=nct'
 #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,
@@ -611,14 +613,14 @@ C Now partition the electrostatic-interaction array
       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
@@ -627,7 +629,7 @@ c     & " my_ele_inde_vdw",my_ele_inde_vdw
       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)
@@ -655,15 +657,15 @@ c     &   " ielend_vdw",ielend_vdw(i)
      &  ' 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,
@@ -675,20 +677,20 @@ C Partition the SC-p interaction array
       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
@@ -719,7 +721,7 @@ cd        write (iout,*) 'i.gt.nct-iscp'
       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
@@ -782,24 +784,24 @@ c     &  " ivec_start",ivec_start," ivec_end",ivec_end
       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,
@@ -818,13 +820,13 @@ c      nlen=nres-nnt+1
      & ' 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,
@@ -1502,6 +1504,31 @@ c---------------------------------------------------------------------------
       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
+      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_bounds1(total_ints,lower_bound,upper_bound)
       implicit none
       include 'DIMENSIONS'
@@ -1566,6 +1593,47 @@ c---------------------------------------------------------------------------
       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
+      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
 #endif
 c------------------------------------------------------------------------------
       subroutine hpb_partition