block data
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.MCM'
      include 'COMMON.MD'
      data MovTypID
     &  /'pool','chain regrow','multi-bond','phi','theta','side chain',
     &   'total'/
c Conversion from poises to molecular unit and the gas constant
      data cPoise /2.9361d0/, Rb /0.001986d0/
      end
c--------------------------------------------------------------------------
      subroutine initialize
C 
C Define constants and zero out tables.
C
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
#ifdef MPI
      include 'mpif.h'
#endif
#ifndef ISNAN
      external proc_proc
#ifdef WINPGI
cMS$ATTRIBUTES C ::  proc_proc
#endif
#endif
      include 'COMMON.IOUNITS'
      include 'COMMON.CHAIN'
      include 'COMMON.INTERACT'
      include 'COMMON.GEO'
      include 'COMMON.LOCAL'
      include 'COMMON.TORSION'
      include 'COMMON.FFIELD'
      include 'COMMON.SBRIDGE'
      include 'COMMON.MCM'
      include 'COMMON.MINIM' 
      include 'COMMON.DERIV'
      include 'COMMON.SPLITELE'
c Common blocks from the diagonalization routines
      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.
#ifndef ISNAN
c NaNQ initialization
      i=-1
      rr=dacos(100.0d0)
#ifdef WINPGI
      idumm=proc_proc(rr,i)
#else
      call proc_proc(rr,i)
#endif
#endif

      kdiag=0
      icorfl=0
      iw=2
C
C The following is just to define auxiliary variables used in angle conversion
C
      pi=4.0D0*datan(1.0D0)
      dwapi=2.0D0*pi
      dwapi3=dwapi/3.0D0
      pipol=0.5D0*pi
      deg2rad=pi/180.0D0
      rad2deg=1.0D0/deg2rad
      angmin=10.0D0*deg2rad
C
C Define I/O units.
C
      inp=    1
      iout=   2
      ipdbin= 3
      ipdb=   7
      icart = 30
      imol2=  4
      igeom=  8
      intin=  9
      ithep= 11
      irotam=12
      itorp= 13
      itordp= 23
      ielep= 14
      isidep=15 
      iscpp=25
      icbase=16
      ifourier=20
      istat= 17
      irest1=55
      irest2=56
      iifrag=57
      ientin=18
      ientout=19
      ibond = 28
      isccor = 29
crc for write_rmsbank1  
      izs1=21
cdr  include secondary structure prediction bias
      isecpred=27
C
C CSA I/O units (separated from others especially for Jooyoung)
C
      icsa_rbank=30
      icsa_seed=31
      icsa_history=32
      icsa_bank=33
      icsa_bank1=34
      icsa_alpha=35
      icsa_alpha1=36
      icsa_bankt=37
      icsa_int=39
      icsa_bank_reminimized=38
      icsa_native_int=41
      icsa_in=40
crc for ifc error 118
      icsa_pdb=42
C
C Set default weights of the energy terms.
C
      wlong=1.0D0
      welec=1.0D0
      wtor =1.0D0
      wang =1.0D0
      wscloc=1.0D0
      wstrain=1.0D0
C
C Zero out tables.
C
      print '(a,$)','Inside initialize'
c      call memmon_print_usage()
      do i=1,maxres2
	do j=1,3
	  c(j,i)=0.0D0
	  dc(j,i)=0.0D0
        enddo
      enddo
      do i=1,maxres
	do j=1,3
	  xloc(j,i)=0.0D0
        enddo
      enddo
      do i=1,ntyp
	do j=1,ntyp
	  aa(i,j)=0.0D0
	  bb(i,j)=0.0D0
	  augm(i,j)=0.0D0
	  sigma(i,j)=0.0D0
	  r0(i,j)=0.0D0
	  chi(i,j)=0.0D0
        enddo
	do j=1,2
	  bad(i,j)=0.0D0
        enddo
	chip(i)=0.0D0
	alp(i)=0.0D0
	sigma0(i)=0.0D0
	sigii(i)=0.0D0
	rr0(i)=0.0D0
	a0thet(i)=0.0D0
	do j=1,2
	  athet(j,i)=0.0D0
	  bthet(j,i)=0.0D0
        enddo
	do j=0,3
	  polthet(j,i)=0.0D0
        enddo
	do j=1,3
	  gthet(j,i)=0.0D0
        enddo
	theta0(i)=0.0D0
	sig0(i)=0.0D0
	sigc0(i)=0.0D0
	do j=1,maxlob
	  bsc(j,i)=0.0D0
	  do k=1,3
	    censc(k,j,i)=0.0D0
          enddo
          do k=1,3
	    do l=1,3
	      gaussc(l,k,j,i)=0.0D0
            enddo
          enddo
	  nlob(i)=0
        enddo
      enddo
      nlob(ntyp1)=0
      dsc(ntyp1)=0.0D0
      do i=1,maxtor
	itortyp(i)=0
	do j=1,maxtor
	  do k=1,maxterm
	    v1(k,j,i)=0.0D0
	    v2(k,j,i)=0.0D0
          enddo
        enddo
      enddo
      do i=1,maxres
	itype(i)=0
	itel(i)=0
      enddo
C Initialize the bridge arrays
      ns=0
      nss=0 
      nhpb=0
      do i=1,maxss
	iss(i)=0
      enddo
      do i=1,maxdim
	dhpb(i)=0.0D0
      enddo
      do i=1,maxres
	ihpb(i)=0
	jhpb(i)=0
      enddo
C
C Initialize timing.
C
      call set_timers
C
C Initialize variables used in minimization.
C   
c     maxfun=5000
c     maxit=2000
      maxfun=500
      maxit=200
      tolf=1.0D-2
      rtolf=5.0D-4
C 
C Initialize the variables responsible for the mode of gradient storage.
C
      nfl=0
      icg=1
C
C Initialize constants used to split the energy into long- and short-range
C components
C
      r_cut=2.0d0
      rlamb=0.3d0
#ifndef SPLITELE
      nprint_ene=nprint_ene-1
#endif
      return
      end
c-------------------------------------------------------------------------
      block data nazwy
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.NAMES'
      include 'COMMON.FFIELD'
      data restyp /
     &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
     &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
      data onelet /
     &'C','M','F','I','L','V','W','Y','A','G','T',
     &'S','Q','N','E','D','H','R','K','P','X'/
      data potname /'LJ','LJK','BP','GB','GBV'/
      data ename /
     &   "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
     &   "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
     &   "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
     &   "ESTR ","EVDW2_14 ","UCONST ", "      ","ESCCOR"/
      data wname /
     &   "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
     &   "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
     &   "WSTRAIN","WVDWPP","WBOND","SCAL14","     ","    ","WSCCOR"/
      data nprint_ene /20/
      data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
     & 21,0/
      end 
c---------------------------------------------------------------------------
      subroutine init_int_table
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
#ifdef MPI
      include 'mpif.h'
      integer blocklengths(15),displs(15)
#endif
      include 'COMMON.CONTROL'
      include 'COMMON.SETUP'
      include 'COMMON.CHAIN'
      include 'COMMON.INTERACT'
      include 'COMMON.LOCAL'
      include 'COMMON.SBRIDGE'
      include 'COMMON.TORCNSTR'
      include 'COMMON.IOUNITS'
      logical scheck,lprint
#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.
      lprint=.false.
      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)
      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
      iatsc_s=0
      iatsc_e=0
#endif
c      lprint=.false.
      do i=1,maxres
        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
cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
cd   &   (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
cd      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=ind_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) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
     &   ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
#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
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)
      if (lprint)
     & write (*,*) 'Processor',fg_rank,' CG group',kolor,
     &  ' absolute rank',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 (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
     &  ' 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)
        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)
      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,
     &               ' 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
cd        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
cd        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
C 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(nct-nnt-3,iphid_start,iphid_end) 
      iphid_start=iphid_start+nnt+2
      iphid_end=iphid_end+nnt+2
      call int_bounds(nres-2,ibond_start,ibond_end) 
      ibond_start=ibond_start+1
      ibond_end=ibond_end+1
      call int_bounds(nct-nnt,ibondp_start,ibondp_end) 
      ibondp_start=ibondp_start+nnt
      ibondp_end=ibondp_end+nnt
      call int_bounds(nres-1,ivec_start,ivec_end) 
      iset_start=loc_start+2
      iset_end=loc_end+2
      if (ndih_constr.eq.0) then
        idihconstr_start=1
        idihconstr_end=0
      else
        call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
      endif
      lprint=.true.
      if (lprint) then 
        write (*,*) 'Processor:',fg_rank,' CG group',kolor,
     & ' absolute rank',myrank,
     & ' loc_start',loc_start,' loc_end',loc_end,
     & ' ithet_start',ithet_start,' ithet_end',ithet_end,
     & ' iphi_start',iphi_start,' iphi_end',iphi_end,
     & ' iphid_start',iphid_start,' iphid_end',iphid_end,
     & ' ibond_start',ibond_start,' ibond_end',ibond_end,
     & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
     & ' ivec_start',ivec_start,' ivec_end',ivec_end,
     & ' iset_start',iset_start,' iset_end',iset_end,
     & ' idihconstr_start',idihconstr_start,' idihconstr_end',
     &   idihconstr_end
      endif
      if (nfgtasks.gt.1) then
        call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
     &    MPI_INTEGER,FG_COMM,IERROR)
        iaux=ivec_end-ivec_start+1
        call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
     &    MPI_INTEGER,FG_COMM,IERROR)
        call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
     &    MPI_INTEGER,FG_COMM,IERROR)
        iaux=iset_end-iset_start+1
        call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
     &    MPI_INTEGER,FG_COMM,IERROR)
        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,
     &    IERROR)
        call MPI_Type_commit(MPI_UYZGRAD,IERROR)
        call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
        call MPI_Type_commit(MPI_MU,IERROR)
        call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
        call MPI_Type_commit(MPI_MAT1,IERROR)
        call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
        call MPI_Type_commit(MPI_MAT2,IERROR)
#ifndef MATGATHER
c 9/22/08 Derived types to send matrices which appear in correlation terms
        do i=0,nfgtasks-1
          if (ivec_count(i).eq.ivec_count(0)) then
            lentyp(i)=0
          else
            lentyp(i)=1
          endif
        enddo
        do ind_typ=lentyp(0),lentyp(nfgtasks-1)
        if (ind_typ.eq.0) then
          ichunk=ivec_count(0)
        else
          ichunk=ivec_count(1)
        endif
c        do i=1,4
c          blocklengths(i)=4
c        enddo
c        displs(1)=0
c        do i=2,4
c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
c        enddo
c        do i=1,4
c          blocklengths(i)=blocklengths(i)*ichunk
c        enddo
c        write (iout,*) "blocklengths and displs"
c        do i=1,4
c          write (iout,*) i,blocklengths(i),displs(i)
c        enddo
c        call flush(iout)
c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
c        call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
c        write (iout,*) "MPI_ROTAT1",MPI_ROTAT1 
c        do i=1,4
c          blocklengths(i)=2
c        enddo
c        displs(1)=0
c        do i=2,4
c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
c        enddo
c        do i=1,4
c          blocklengths(i)=blocklengths(i)*ichunk
c        enddo
c        write (iout,*) "blocklengths and displs"
c        do i=1,4
c          write (iout,*) i,blocklengths(i),displs(i)
c        enddo
c        call flush(iout)
c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
c        call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
c        write (iout,*) "MPI_ROTAT2",MPI_ROTAT2 
        do i=1,8
          blocklengths(i)=2
        enddo
        displs(1)=0
        do i=2,8
          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
        enddo
        do i=1,15
          blocklengths(i)=blocklengths(i)*ichunk
        enddo
        call MPI_Type_indexed(8,blocklengths,displs,
     &    MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
        call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
        do i=1,8
          blocklengths(i)=4
        enddo
        displs(1)=0
        do i=2,8
          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
        enddo
        do i=1,15
          blocklengths(i)=blocklengths(i)*ichunk
        enddo
        call MPI_Type_indexed(8,blocklengths,displs,
     &    MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
        call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
        do i=1,6
          blocklengths(i)=4
        enddo
        displs(1)=0
        do i=2,6
          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
        enddo
        do i=1,6
          blocklengths(i)=blocklengths(i)*ichunk
        enddo
        call MPI_Type_indexed(6,blocklengths,displs,
     &    MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
        call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
        do i=1,2
          blocklengths(i)=8
        enddo
        displs(1)=0
        do i=2,2
          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
        enddo
        do i=1,2
          blocklengths(i)=blocklengths(i)*ichunk
        enddo
        call MPI_Type_indexed(2,blocklengths,displs,
     &    MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
        call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
        do i=1,4
          blocklengths(i)=1
        enddo
        displs(1)=0
        do i=2,4
          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
        enddo
        do i=1,4
          blocklengths(i)=blocklengths(i)*ichunk
        enddo
        call MPI_Type_indexed(4,blocklengths,displs,
     &    MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
        call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
        enddo
#endif
      endif
      do i=0,nfgtasks-1
          ivec_displ(i)=ivec_displ(i)-1
          iset_displ(i)=iset_displ(i)-1
      enddo
      if (nfgtasks.gt.1 .and. fg_rank.eq.king 
     &     .and. (me.eq.0 .or. out1file)) then
        write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
        do i=0,nfgtasks-1
          write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
     &      iset_count(i)
        enddo
        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',nfgtasks,
     & ' 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
      idihconstr_start=1
      idihconstr_end=ndih_constr
      iphid_start=iphi_start
      iphid_end=iphi_end-1
      ibond_start=2
      ibond_end=nres-1
      ibondp_start=nnt
      ibondp_end=nct-1
      ivec_start=1
      ivec_end=nres-1
      iset_start=3
      iset_end=nres+1
#endif
      return
      end 
#ifdef MPI
c---------------------------------------------------------------------------
      subroutine int_bounds(total_ints,lower_bound,upper_bound)
      implicit real*8 (a-h,o-z)
      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)
      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_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)
      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
      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
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
#ifdef MPI
      include 'mpif.h'
#endif
      include 'COMMON.SBRIDGE'
      include 'COMMON.IOUNITS'
      include 'COMMON.SETUP'
#ifdef MPI
      call int_bounds(nhpb,link_start,link_end)
cd    write (*,*) 'Processor',fg_rank,' CG group',color,
cd      ' absolute rank',MyRank,
cd   &  ' nhpb',nhpb,' link_start=',link_start,
cd   &  ' link_end',link_end
#else
      link_start=1
      link_end=nhpb
#endif
      return
      end