source/unres/src-HCD-5D/initialize_p.F

   1       block data
   2       implicit none
   3       include 'DIMENSIONS'
   4       include 'COMMON.MCM'
   5 #ifdef LANG0
   6 #ifdef FIVEDIAG
   7       include 'COMMON.LANGEVIN.lang0.5diag'
   8 #else
   9       include 'COMMON.LANGEVIN.lang0'
  10 #endif
  11 #else
  12       include 'COMMON.LANGEVIN'
  13 #endif
  14       data MovTypID
  15      &  /'pool','chain regrow','multi-bond','phi','theta','side chain',
  16      &   'total'/
  17 c Conversion from poises to molecular unit and the gas constant
  18       data cPoise /2.9361d0/, Rb /0.001986d0/
  19       end
  20 c--------------------------------------------------------------------------
  21       subroutine initialize
  22 C
  23 C Define constants and zero out tables.
  24 C
  25       implicit none
  26       include 'DIMENSIONS'
  27 #ifdef MPI
  28       include 'mpif.h'
  29 #endif
  30 #ifndef ISNAN
  31       external proc_proc
  32 #ifdef WINPGI
  33 cMS$ATTRIBUTES C ::  proc_proc
  34 #endif
  35 #endif
  36       include 'COMMON.IOUNITS'
  37       include 'COMMON.CHAIN'
  38       include 'COMMON.INTERACT'
  39       include 'COMMON.GEO'
  40       include 'COMMON.LOCAL'
  41       include 'COMMON.TORSION'
  42       include 'COMMON.FFIELD'
  43       include 'COMMON.SBRIDGE'
  44       include 'COMMON.MCM'
  45       include 'COMMON.MINIM'
  46       include 'COMMON.DERIV'
  47       include 'COMMON.SPLITELE'
  48       include 'COMMON.VAR'
  49       include 'COMMON.MD'
  50 c Common blocks from the diagonalization routines
  51       integer IR,IW,IP,IJK,IPK,IDAF,NAV,IODA,KDIAG,ICORFL,IXDR
  52       integer i,idumm,j,k,l,ichir1,ichir2,iblock,m
  53       double precision rr
  54       COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
  55       COMMON /MACHSW/ KDIAG,ICORFL,IXDR
  56 c      real*8 text1 /'initial_i'/
  57
  58       mask_r=.false.
  59       mask_theta=1
  60       mask_phi=1
  61       mask_side=1
  62 #ifndef ISNAN
  63 c NaNQ initialization
  64       i=-1
  65       rr=dacos(100.0d0)
  66 #ifdef WINPGI
  67       idumm=proc_proc(rr,i)
  68 #else
  69       call proc_proc(rr,i)
  70 #endif
  71 #endif
  72       itime_mat=0.
  73       kdiag=0
  74       icorfl=0
  75       iw=2
  76 C
  77 C The following is just to define auxiliary variables used in angle conversion
  78 C
  79       pi=4.0D0*datan(1.0D0)
  80       dwapi=2.0D0*pi
  81       dwapi3=dwapi/3.0D0
  82       pipol=0.5D0*pi
  83       deg2rad=pi/180.0D0
  84       rad2deg=1.0D0/deg2rad
  85       angmin=10.0D0*deg2rad
  86 C
  87 C Define I/O units.
  88 C
  89       inp=    1
  90       iout=   2
  91       ipdbin= 3
  92       ipdb=   7
  93       icart = 30
  94       imol2=  4
  95       igeom=  8
  96       intin=  9
  97       ithep= 11
  98       ithep_pdb=51
  99       irotam=12
 100       irotam_pdb=52
 101       itorp= 13
 102       itordp= 23
 103       ielep= 14
 104       isidep=15
 105       iscpp=25
 106       icbase=16
 107       ifourier=20
 108       istat= 17
 109       irest1=55
 110       irest2=56
 111       iifrag=57
 112       ientin=18
 113       ientout=19
 114       ibond = 28
 115       isccor = 29
 116 crc for write_rmsbank1
 117       izs1=21
 118 cdr  include secondary structure prediction bias
 119       isecpred=27
 120 C
 121 C CSA I/O units (separated from others especially for Jooyoung)
 122 C
 123       icsa_rbank=30
 124       icsa_seed=31
 125       icsa_history=32
 126       icsa_bank=33
 127       icsa_bank1=34
 128       icsa_alpha=35
 129       icsa_alpha1=36
 130       icsa_bankt=37
 131       icsa_int=39
 132       icsa_bank_reminimized=38
 133       icsa_native_int=41
 134       icsa_in=40
 135 crc for ifc error 118
 136       icsa_pdb=42
 137       itube=45
 138 C Lipidic input file for parameters range 60-79
 139       iliptranpar=60
 140 C input file for transfer sidechain and peptide group inside the
 141 C lipidic environment if lipid is implicite
 142
 143 C DNA input files for parameters range 80-99
 144 C Sugar input files for parameters range 100-119
 145 C All-atom input files for parameters range 120-149
 146 C
 147 C Set default weights of the energy terms.
 148 C
 149       wsc=1.0D0
 150       welec=1.0D0
 151       wtor =1.0D0
 152       wang =1.0D0
 153       wscloc=1.0D0
 154       wstrain=1.0D0
 155 C
 156 C Zero out tables.
 157 C
 158 c      print '(a,$)','Inside initialize'
 159 c      call memmon_print_usage()
 160       do i=1,maxres2
 161         do j=1,3
 162           c(j,i)=0.0D0
 163           dc(j,i)=0.0D0
 164         enddo
 165       enddo
 166       do i=1,maxres
 167         do j=1,3
 168           xloc(j,i)=0.0D0
 169         enddo
 170       enddo
 171       do i=1,ntyp
 172         do j=1,ntyp
 173           aa_aq(i,j)=0.0D0
 174           bb_aq(i,j)=0.0D0
 175           aa_lip(i,j)=0.0D0
 176           bb_lip(i,j)=0.0D0
 177           augm(i,j)=0.0D0
 178           sigma(i,j)=0.0D0
 179           r0(i,j)=0.0D0
 180           chi(i,j)=0.0D0
 181         enddo
 182         do j=1,2
 183           bad(i,j)=0.0D0
 184         enddo
 185         chip(i)=0.0D0
 186         alp(i)=0.0D0
 187         sigma0(i)=0.0D0
 188         sigii(i)=0.0D0
 189         rr0(i)=0.0D0
 190         a0thet(i)=0.0D0
 191         do j=1,2
 192          do ichir1=-1,1
 193           do ichir2=-1,1
 194           athet(j,i,ichir1,ichir2)=0.0D0
 195           bthet(j,i,ichir1,ichir2)=0.0D0
 196           enddo
 197          enddo
 198         enddo
 199         do j=0,3
 200           polthet(j,i)=0.0D0
 201         enddo
 202         do j=1,3
 203           gthet(j,i)=0.0D0
 204         enddo
 205         theta0(i)=0.0D0
 206         sig0(i)=0.0D0
 207         sigc0(i)=0.0D0
 208         do j=1,maxlob
 209           bsc(j,i)=0.0D0
 210           do k=1,3
 211             censc(k,j,i)=0.0D0
 212           enddo
 213           do k=1,3
 214             do l=1,3
 215               gaussc(l,k,j,i)=0.0D0
 216             enddo
 217           enddo
 218           nlob(i)=0
 219         enddo
 220       enddo
 221       nlob(ntyp1)=0
 222       dsc(ntyp1)=0.0D0
 223       do i=-maxtor,maxtor
 224         itortyp(i)=0
 225 cc      write (iout,*) "TU DOCHODZE",i,itortyp(i)
 226        do iblock=1,2
 227         do j=-maxtor,maxtor
 228           do k=1,maxterm
 229             v1(k,j,i,iblock)=0.0D0
 230             v2(k,j,i,iblock)=0.0D0
 231           enddo
 232         enddo
 233         enddo
 234       enddo
 235       do iblock=1,2
 236        do i=-maxtor,maxtor
 237         do j=-maxtor,maxtor
 238          do k=-maxtor,maxtor
 239           do l=1,maxtermd_1
 240             v1c(1,l,i,j,k,iblock)=0.0D0
 241             v1s(1,l,i,j,k,iblock)=0.0D0
 242             v1c(2,l,i,j,k,iblock)=0.0D0
 243             v1s(2,l,i,j,k,iblock)=0.0D0
 244           enddo !l
 245           do l=1,maxtermd_2
 246            do m=1,maxtermd_2
 247             v2c(m,l,i,j,k,iblock)=0.0D0
 248             v2s(m,l,i,j,k,iblock)=0.0D0
 249            enddo !m
 250           enddo !l
 251         enddo !k
 252        enddo !j
 253       enddo !i
 254       enddo !iblock
 255
 256       do i=1,maxres
 257         itype(i)=0
 258         itel(i)=0
 259       enddo
 260 C Initialize the bridge arrays
 261       ns=0
 262       nss=0
 263       nhpb=0
 264       do i=1,max_cyst
 265         iss(i)=0
 266       enddo
 267       do i=1,maxdim_cont
 268         dhpb(i)=0.0D0
 269       enddo
 270       do i=1,maxres
 271         ihpb(i)=0
 272         jhpb(i)=0
 273       enddo
 274 C Initialize correlation arrays
 275       do i=1,maxres
 276        do k=1,2
 277         b1(k,i)=0.0
 278         b2(k,i)=0.0
 279         b1tilde(k,i)=0.0
 280 c        b2tilde(k,i)=0.0
 281         do j=1,2
 282 C        CC(j,k,i)=0.0
 283 C        Ctilde(j,k,i)=0.0
 284 C        DD(j,k,i)=0.0
 285 C        Dtilde(j,k,i)=0.0
 286         EE(j,k,i)=0.0
 287         enddo
 288        enddo
 289       enddo
 290       do i=1,maxres
 291        do k=1,2
 292         do j=1,2
 293         CC(j,k,i)=0.0
 294         Ctilde(j,k,i)=0.0
 295         DD(j,k,i)=0.0
 296         Dtilde(j,k,i)=0.0
 297         enddo
 298       enddo
 299       enddo
 300 C
 301 C Initialize timing.
 302 C
 303       call set_timers
 304 C
 305 C Initialize variables used in minimization.
 306 C
 307 c     maxfun=5000
 308 c     maxit=2000
 309       maxfun=1000
 310       maxmin=500
 311       tolf=1.0D-2
 312       rtolf=5.0D-4
 313 C
 314 C Initialize the variables responsible for the mode of gradient storage.
 315 C
 316       nfl=0
 317       icg=1
 318       sideonly=.false.
 319 C
 320 C Initialize constants used to split the energy into long- and short-range
 321 C components
 322 C
 323 C      r_cut=2.0d0
 324 C      rlamb=0.3d0
 325 #ifndef SPLITELE
 326       nprint_ene=nprint_ene-1
 327 #endif
 328       return
 329       end
 330 c-------------------------------------------------------------------------
 331       block data nazwy
 332       implicit none
 333       include 'DIMENSIONS'
 334       include 'COMMON.NAMES'
 335       include 'COMMON.FFIELD'
 336       data restyp /
 337      &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
 338      & 'DSG','DGN','DSN','DTH',
 339      &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
 340      &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
 341      &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
 342      &'AIB','ABU','D'/
 343       data onelet /
 344      &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
 345      &'a','y','w','v','l','i','f','m','c','x',
 346      &'C','M','F','I','L','V','W','Y','A','G','T',
 347      &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
 348       data potname /'LJ','LJK','BP','GB','GBV'/
 349       data wname /
 350 !          1        2        3       4       5        6        7
 351      1   "WSC   ","WSCP  ","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
 352 !          8        9       10      11      12       13       14
 353      8   "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR  ","WTORD  ",
 354 !?        15       16       17      18      19       20       21
 355      5   "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR",
 356 !         22       23       24      25      26       27       28
 357      2   "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD",
 358 !         29       30       31
 359      3   "WDFAT","WDFAN","WDFAB"/
 360       data ename /
 361      1   "ESC-SC",
 362      2   "ESC-p",
 363      3   "Ep-p(el)",
 364      4   "ECORR4",
 365      5   "ECORR5",
 366      6   "ECORR6",
 367      7   "ECORR3",
 368      8   "ETURN3",
 369      9   "ETURN4",
 370      @   "ETURN6",
 371      1   "Ebend",
 372      2   "ESCloc",
 373      3   "ETORS",
 374      4   "ETORSD",
 375      5   "Edist",
 376      6   "Epp(VDW)",
 377      7   "Ebond",
 378      8   "ESCp_14",
 379      9   "EDIHC",
 380      @   "UCONST",
 381      1   "ESCcorr",
 382      2   "ELIPTRAN",
 383      3   "EAFM",
 384      4   "ETHETC",
 385      5   "ETUBE",
 386      6   "ESAXS",
 387      7   "EHOMO",
 388      8   "EDFADIS",
 389      9   "EDFATOR",
 390      @   "EDFANEI",
 391      1   "EDFABET"/
 392 #ifdef DFA
 393 #if defined(SCP14) && defined(SPLITELE)
 394       data nprint_ene /31/
 395       data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 396      & 24,15,26,27,28,29,30,31,22,23,25,20/
 397 #elif defined(SCP14)
 398       data nprint_ene /30/
 399       data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 400      & 24,15,26,27,28,29,30,31,22,23,25,20,0/
 401 #elif defined(SPLITELE)
 402       data nprint_ene /30/
 403       data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 404      & 24,15,26,27,28,29,30,31,22,23,25,20,0/
 405 #else
 406       data nprint_ene /29/
 407       data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 408      & 24,15,26,27,28,29,30,31,22,23,25,20,2*0/
 409 #endif
 410 #else
 411 #if defined(SCP14) && defined(SPLITELE)
 412       data nprint_ene /27/
 413       data print_order/1,2,18,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 414      & 24,15,26,27,22,23,25,20,4*0/
 415 #elif defined(SCP14)
 416       data nprint_ene /26/
 417       data print_order/1,2,18,3,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 418      & 24,15,26,27,22,23,25,20,5*0/
 419 #elif defined(SPLITELE)
 420       data nprint_ene /26/
 421       data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 422      & 24,15,26,27,22,23,25,20,5*0/
 423 #else
 424       data nprint_ene /25/
 425       data print_order/1,2,3,16,17,11,12,13,14,4,5,6,7,8,9,10,21,19,
 426      & 24,15,26,27,22,23,25,20,6*0/
 427 #endif
 428 #endif
 429       end
 430 c---------------------------------------------------------------------------
 431       subroutine init_int_table
 432       implicit none
 433       include 'DIMENSIONS'
 434 #ifdef MPI
 435       include 'mpif.h'
 436       integer ierr,ierror
 437       integer blocklengths(15),displs(15)
 438 #endif
 439       include 'COMMON.CONTROL'
 440       include 'COMMON.SAXS'
 441       include 'COMMON.SETUP'
 442       include 'COMMON.CHAIN'
 443       include 'COMMON.INTERACT'
 444       include 'COMMON.LOCAL'
 445       include 'COMMON.SBRIDGE'
 446       include 'COMMON.TORCNSTR'
 447       include 'COMMON.IOUNITS'
 448       include 'COMMON.DERIV'
 449 #ifdef FOURBODY
 450       include 'COMMON.CONTMAT'
 451 #endif
 452       include 'COMMON.CORRMAT'
 453       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
 454      & iturn4_end_all,iatel_s_all,
 455      & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
 456      & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all
 457       integer*8 n_sc_int_tot,my_sc_inds,my_sc_inde,ind_scint,
 458      & ind_scint_old,nele_int_tot,ind_eleint,my_ele_inds,my_ele_inde,
 459      & ind_eleint_old,nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw,
 460      & ind_eleint_vdw,ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,
 461      & my_scp_inde,ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,
 462      & ngrad_end
 463       common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
 464      & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
 465      & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
 466      &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
 467      & ielend_all(maxres,0:max_fg_procs-1),
 468      & ntask_cont_from_all(0:max_fg_procs-1),
 469      & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
 470      & ntask_cont_to_all(0:max_fg_procs-1),
 471      & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
 472       integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
 473       logical scheck,lprint,flag
 474       integer i,j,k,ii,jj,iint,npept,
 475      & ijunk,iaux,ind_typ,ncheck_from,ncheck_to,ichunk
 476 #ifdef MPI
 477       integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
 478      & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
 479 C... Determine the numbers of start and end SC-SC interaction
 480 C... to deal with by current processor.
 481 #ifdef FOURBODY
 482       do i=0,nfgtasks-1
 483         itask_cont_from(i)=fg_rank
 484         itask_cont_to(i)=fg_rank
 485       enddo
 486 #endif
 487       lprint=energy_dec
 488       if (lprint)
 489      &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
 490       n_sc_int_tot=int(nct-nnt+1,8)*int(nct-nnt,8)/2-nss
 491       call int_bounds8(n_sc_int_tot,my_sc_inds,my_sc_inde)
 492       if (lprint)
 493      &  write (iout,*) 'Processor',fg_rank,' CG group',kolor,
 494      &  ' absolute rank',MyRank,
 495      &  ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
 496      &  ' my_sc_inde',my_sc_inde
 497       ind_scint=0
 498       iatsc_s=0
 499       iatsc_e=0
 500 #endif
 501 c      lprint=.false.
 502       do i=1,maxres
 503         nint_gr(i)=0
 504         nscp_gr(i)=0
 505         do j=1,maxint_gr
 506           istart(i,1)=0
 507           iend(i,1)=0
 508           ielstart(i)=0
 509           ielend(i)=0
 510           iscpstart(i,1)=0
 511           iscpend(i,1)=0
 512         enddo
 513       enddo
 514       ind_scint=0
 515       ind_scint_old=0
 516 cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 517 cd   &   (ihpb(i),jhpb(i),i=1,nss)
 518       do i=nnt,nct-1
 519         scheck=.false.
 520         if (dyn_ss) goto 10
 521         do ii=1,nss
 522           if (ihpb(ii).eq.i+nres) then
 523             scheck=.true.
 524             jj=jhpb(ii)-nres
 525             goto 10
 526           endif
 527         enddo
 528    10   continue
 529 cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 530         if (scheck) then
 531           if (jj.eq.i+1) then
 532 #ifdef MPI
 533 c            write (iout,*) 'jj=i+1'
 534             call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
 535      & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 536 #else
 537             nint_gr(i)=1
 538             istart(i,1)=i+2
 539             iend(i,1)=nct
 540 #endif
 541           else if (jj.eq.nct) then
 542 #ifdef MPI
 543 c            write (iout,*) 'jj=nct'
 544             call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
 545      &  iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 546 #else
 547             nint_gr(i)=1
 548             istart(i,1)=i+1
 549             iend(i,1)=nct-1
 550 #endif
 551           else
 552 #ifdef MPI
 553             call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
 554      & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 555             ii=nint_gr(i)+1
 556             call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
 557      & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
 558 #else
 559             nint_gr(i)=2
 560             istart(i,1)=i+1
 561             iend(i,1)=jj-1
 562             istart(i,2)=jj+1
 563             iend(i,2)=nct
 564 #endif
 565           endif
 566         else
 567 #ifdef MPI
 568           call int_partition8(ind_scint,my_sc_inds,my_sc_inde,i,
 569      &    iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 570 #else
 571           nint_gr(i)=1
 572           istart(i,1)=i+1
 573           iend(i,1)=nct
 574           ind_scint=ind_scint+nct-i
 575 #endif
 576         endif
 577 #ifdef MPI
 578         ind_scint_old=ind_scint
 579 #endif
 580       enddo
 581    12 continue
 582 #ifndef MPI
 583       iatsc_s=nnt
 584       iatsc_e=nct-1
 585 #endif
 586       if (iatsc_s.eq.0) iatsc_s=1
 587 #ifdef MPI
 588       if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
 589      &   ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
 590 #endif
 591       if (lprint) then
 592       write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
 593       write (iout,'(a)') 'Interaction array:'
 594       do i=iatsc_s,iatsc_e
 595         write (iout,'(i7,2(2x,2i7))')
 596      & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 597       enddo
 598       endif
 599       ispp=4
 600 #ifdef MPI
 601 C Now partition the electrostatic-interaction array
 602       npept=nct-nnt
 603       nele_int_tot=int(npept-ispp,8)*int(npept-ispp+1,8)/2
 604       call int_bounds8(nele_int_tot,my_ele_inds,my_ele_inde)
 605       if (lprint)
 606      & write (*,*) 'Processor',fg_rank,' CG group',kolor,
 607      &  ' absolute rank',MyRank,
 608      &  ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
 609      &               ' my_ele_inde',my_ele_inde
 610       iatel_s=0
 611       iatel_e=0
 612       ind_eleint=0
 613       ind_eleint_old=0
 614       do i=nnt,nct-3
 615         ijunk=0
 616         call int_partition8(ind_eleint,my_ele_inds,my_ele_inde,i,
 617      &    iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
 618       enddo ! i
 619    13 continue
 620       if (iatel_s.eq.0) iatel_s=1
 621       nele_int_tot_vdw=int(npept-2,8)*int(npept-2+1,8)/2
 622 c      write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
 623       call int_bounds8(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
 624 c      write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
 625 c     & " my_ele_inde_vdw",my_ele_inde_vdw
 626       ind_eleint_vdw=0
 627       ind_eleint_vdw_old=0
 628       iatel_s_vdw=0
 629       iatel_e_vdw=0
 630       do i=nnt,nct-3
 631         ijunk=0
 632         call int_partition8(ind_eleint_vdw,my_ele_inds_vdw,
 633      &    my_ele_inde_vdw,i,
 634      &    iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
 635      &    ielend_vdw(i),*15)
 636 c        write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
 637 c     &   " ielend_vdw",ielend_vdw(i)
 638       enddo ! i
 639       if (iatel_s_vdw.eq.0) iatel_s_vdw=1
 640    15 continue
 641 #else
 642       iatel_s=nnt
 643       iatel_e=nct-5
 644       do i=iatel_s,iatel_e
 645         ielstart(i)=i+4
 646         ielend(i)=nct-1
 647       enddo
 648       iatel_s_vdw=nnt
 649       iatel_e_vdw=nct-3
 650       do i=iatel_s_vdw,iatel_e_vdw
 651         ielstart_vdw(i)=i+2
 652         ielend_vdw(i)=nct-1
 653       enddo
 654 #endif
 655       if (lprint) then
 656         write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
 657      &  ' absolute rank',MyRank
 658         write (iout,*) 'Electrostatic interaction array:'
 659         do i=iatel_s,iatel_e
 660           write (iout,'(i7,2(2x,2i7))') i,ielstart(i),ielend(i)
 661         enddo
 662       endif ! lprint
 663 c     iscp=3
 664       iscp=2
 665 C Partition the SC-p interaction array
 666 #ifdef MPI
 667       nscp_int_tot=int(npept-iscp+1,8)*int(npept-iscp+1,8)
 668       call int_bounds8(nscp_int_tot,my_scp_inds,my_scp_inde)
 669       if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
 670      &  ' absolute rank',myrank,
 671      &  ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
 672      &               ' my_scp_inde',my_scp_inde
 673       iatscp_s=0
 674       iatscp_e=0
 675       ind_scpint=0
 676       ind_scpint_old=0
 677       do i=nnt,nct-1
 678         if (i.lt.nnt+iscp) then
 679 cd        write (iout,*) 'i.le.nnt+iscp'
 680           call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
 681      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
 682      &      iscpend(i,1),*14)
 683         else if (i.gt.nct-iscp) then
 684 cd        write (iout,*) 'i.gt.nct-iscp'
 685           call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
 686      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 687      &      iscpend(i,1),*14)
 688         else
 689           call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
 690      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 691      &      iscpend(i,1),*14)
 692           ii=nscp_gr(i)+1
 693           call int_partition8(ind_scpint,my_scp_inds,my_scp_inde,i,
 694      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
 695      &      iscpend(i,ii),*14)
 696         endif
 697       enddo ! i
 698    14 continue
 699 #else
 700       iatscp_s=nnt
 701       iatscp_e=nct-1
 702       do i=nnt,nct-1
 703         if (i.lt.nnt+iscp) then
 704           nscp_gr(i)=1
 705           iscpstart(i,1)=i+iscp
 706           iscpend(i,1)=nct
 707         elseif (i.gt.nct-iscp) then
 708           nscp_gr(i)=1
 709           iscpstart(i,1)=nnt
 710           iscpend(i,1)=i-iscp
 711         else
 712           nscp_gr(i)=2
 713           iscpstart(i,1)=nnt
 714           iscpend(i,1)=i-iscp
 715           iscpstart(i,2)=i+iscp
 716           iscpend(i,2)=nct
 717         endif
 718       enddo ! i
 719 #endif
 720       if (iatscp_s.eq.0) iatscp_s=1
 721       if (lprint) then
 722         write (iout,'(a)') 'SC-p interaction array:'
 723         do i=iatscp_s,iatscp_e
 724           write (iout,'(i7,2(2x,2i7))')
 725      &         i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 726         enddo
 727       endif ! lprint
 728 C Partition local interactions
 729 #ifdef MPI
 730       call int_bounds(nres-2,loc_start,loc_end)
 731       loc_start=loc_start+1
 732       loc_end=loc_end+1
 733       call int_bounds(nres-2,ithet_start,ithet_end)
 734       call int_bounds(nsaxs,isaxs_start,isaxs_end)
 735       write (iout,*) me," isaxs_start",isaxs_start,
 736      &  " isaxs_end",isaxs_end
 737       ithet_start=ithet_start+2
 738       ithet_end=ithet_end+2
 739       call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
 740       iturn3_start=iturn3_start+nnt
 741       iphi_start=iturn3_start+2
 742       iturn3_end=iturn3_end+nnt
 743       iphi_end=iturn3_end+2
 744       iturn3_start=iturn3_start-1
 745       iturn3_end=iturn3_end-1
 746       call int_bounds(nres-3,itau_start,itau_end)
 747       itau_start=itau_start+3
 748       itau_end=itau_end+3
 749       call int_bounds(nres-3,iphi1_start,iphi1_end)
 750       iphi1_start=iphi1_start+3
 751       iphi1_end=iphi1_end+3
 752       call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
 753       iturn4_start=iturn4_start+nnt
 754       iphid_start=iturn4_start+2
 755       iturn4_end=iturn4_end+nnt
 756       iphid_end=iturn4_end+2
 757       iturn4_start=iturn4_start-1
 758       iturn4_end=iturn4_end-1
 759       call int_bounds(nres-2,ibond_start,ibond_end)
 760       ibond_start=ibond_start+1
 761       ibond_end=ibond_end+1
 762       call int_bounds(nct-nnt,ibondp_start,ibondp_end)
 763       ibondp_start=ibondp_start+nnt
 764       ibondp_end=ibondp_end+nnt
 765       call int_bounds(nres,ilip_start,ilip_end)
 766 c      ilip_start=ilip_start
 767       call int_bounds1(nres-1,ivec_start,ivec_end)
 768 c      print *,"Processor",myrank,fg_rank,fg_rank1,
 769 c     &  " ivec_start",ivec_start," ivec_end",ivec_end
 770       iset_start=loc_start+2
 771       iset_end=loc_end+2
 772       if (ndih_constr.eq.0) then
 773         idihconstr_start=1
 774         idihconstr_end=0
 775       else
 776         call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
 777       endif
 778       if (ntheta_constr.eq.0) then
 779         ithetaconstr_start=1
 780         ithetaconstr_end=0
 781       else
 782         call int_bounds
 783      &  (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
 784       endif
 785 c      nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 786 c      nlen=nres-nnt+1
 787 c      nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 788 c      nlen=nres-nnt+1
 789 c      call int_bounds(nsumgrad,ngrad_start,ngrad_end)
 790 c      igrad_start=((2*nlen+1)
 791 c     &    -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
 792 c      jgrad_start(igrad_start)=
 793 c     &    ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
 794 c     &    +igrad_start
 795 c      jgrad_end(igrad_start)=nres
 796 c      igrad_end=((2*nlen+1)
 797 c     &    -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
 798 c      if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
 799 c      jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
 800 c     &    +igrad_end
 801 c      do i=igrad_start+1,igrad_end-1
 802 c        jgrad_start(i)=i+1
 803 c        jgrad_end(i)=nres
 804 c      enddo
 805       if (lprint) then
 806         write (*,*) 'Processor:',fg_rank,' CG group',kolor,
 807      & ' absolute rank',myrank,
 808      & ' loc_start',loc_start,' loc_end',loc_end,
 809      & ' ithet_start',ithet_start,' ithet_end',ithet_end,
 810      & ' iphi_start',iphi_start,' iphi_end',iphi_end,
 811      & ' iphid_start',iphid_start,' iphid_end',iphid_end,
 812      & ' ibond_start',ibond_start,' ibond_end',ibond_end,
 813      & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
 814      & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
 815      & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
 816      & ' ivec_start',ivec_start,' ivec_end',ivec_end,
 817      & ' iset_start',iset_start,' iset_end',iset_end,
 818      & ' idihconstr_start',idihconstr_start,' idihconstr_end',
 819      &   idihconstr_end,
 820      & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
 821      &   ithetaconstr_end
 822
 823 c       write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
 824 c     &   igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
 825 c     &   ' ngrad_end',ngrad_end
 826 c       do i=igrad_start,igrad_end
 827 c         write(*,*) 'Processor:',fg_rank,myrank,i,
 828 c     &    jgrad_start(i),jgrad_end(i)
 829 c       enddo
 830       endif
 831       if (nfgtasks.gt.1) then
 832         call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
 833      &    MPI_INTEGER,FG_COMM1,IERROR)
 834         iaux=ivec_end-ivec_start+1
 835         call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
 836      &    MPI_INTEGER,FG_COMM1,IERROR)
 837         call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
 838      &    MPI_INTEGER,FG_COMM,IERROR)
 839         iaux=iset_end-iset_start+1
 840         call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
 841      &    MPI_INTEGER,FG_COMM,IERROR)
 842         call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
 843      &    MPI_INTEGER,FG_COMM,IERROR)
 844         iaux=ibond_end-ibond_start+1
 845         call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
 846      &    MPI_INTEGER,FG_COMM,IERROR)
 847         call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
 848      &    MPI_INTEGER,FG_COMM,IERROR)
 849         iaux=ithet_end-ithet_start+1
 850         call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
 851      &    MPI_INTEGER,FG_COMM,IERROR)
 852         call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
 853      &    MPI_INTEGER,FG_COMM,IERROR)
 854         iaux=iphi_end-iphi_start+1
 855         call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
 856      &    MPI_INTEGER,FG_COMM,IERROR)
 857         call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
 858      &    MPI_INTEGER,FG_COMM,IERROR)
 859         iaux=iphi1_end-iphi1_start+1
 860         call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
 861      &    MPI_INTEGER,FG_COMM,IERROR)
 862         do i=0,max_fg_procs-1
 863           do j=1,maxres
 864             ielstart_all(j,i)=0
 865             ielend_all(j,i)=0
 866           enddo
 867         enddo
 868         call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
 869      &    iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 870         call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
 871      &    iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 872         call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
 873      &    iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 874         call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
 875      &    iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 876         call MPI_Allgather(iatel_s,1,MPI_INTEGER,
 877      &    iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 878         call MPI_Allgather(iatel_e,1,MPI_INTEGER,
 879      &    iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 880         call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
 881      &    ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
 882         call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
 883      &    ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
 884         if (lprint) then
 885         write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
 886         write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
 887         write (iout,*) "iturn3_start_all",
 888      &    (iturn3_start_all(i),i=0,nfgtasks-1)
 889         write (iout,*) "iturn3_end_all",
 890      &    (iturn3_end_all(i),i=0,nfgtasks-1)
 891         write (iout,*) "iturn4_start_all",
 892      &    (iturn4_start_all(i),i=0,nfgtasks-1)
 893         write (iout,*) "iturn4_end_all",
 894      &    (iturn4_end_all(i),i=0,nfgtasks-1)
 895         write (iout,*) "The ielstart_all array"
 896         do i=nnt,nct
 897           write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
 898         enddo
 899         write (iout,*) "The ielend_all array"
 900         do i=nnt,nct
 901           write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
 902         enddo
 903         call flush(iout)
 904         endif
 905 #ifdef FOURBODY
 906         ntask_cont_from=0
 907         ntask_cont_to=0
 908         itask_cont_from(0)=fg_rank
 909         itask_cont_to(0)=fg_rank
 910         flag=.false.
 911         do ii=iturn3_start,iturn3_end
 912           call add_int(ii,ii+2,iturn3_sent(1,ii),
 913      &                 ntask_cont_to,itask_cont_to,flag)
 914         enddo
 915         do ii=iturn4_start,iturn4_end
 916           call add_int(ii,ii+3,iturn4_sent(1,ii),
 917      &                 ntask_cont_to,itask_cont_to,flag)
 918         enddo
 919         do ii=iturn3_start,iturn3_end
 920           call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
 921         enddo
 922         do ii=iturn4_start,iturn4_end
 923           call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
 924         enddo
 925         if (lprint) then
 926         write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
 927      &   " ntask_cont_to",ntask_cont_to
 928         write (iout,*) "itask_cont_from",
 929      &    (itask_cont_from(i),i=1,ntask_cont_from)
 930         write (iout,*) "itask_cont_to",
 931      &    (itask_cont_to(i),i=1,ntask_cont_to)
 932         call flush(iout)
 933         endif
 934 c        write (iout,*) "Loop forward"
 935 c        call flush(iout)
 936         do i=iatel_s,iatel_e
 937 c          write (iout,*) "from loop i=",i
 938 c          call flush(iout)
 939           do j=ielstart(i),ielend(i)
 940             call add_int_from(i,j,ntask_cont_from,itask_cont_from)
 941           enddo
 942         enddo
 943 c        write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
 944 c     &     " iatel_e",iatel_e
 945 c        call flush(iout)
 946         nat_sent=0
 947         do i=iatel_s,iatel_e
 948 c          write (iout,*) "i",i," ielstart",ielstart(i),
 949 c     &      " ielend",ielend(i)
 950 c          call flush(iout)
 951           flag=.false.
 952           do j=ielstart(i),ielend(i)
 953             call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
 954      &                   itask_cont_to,flag)
 955           enddo
 956           if (flag) then
 957             nat_sent=nat_sent+1
 958             iat_sent(nat_sent)=i
 959           endif
 960         enddo
 961         if (lprint) then
 962         write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
 963      &   " ntask_cont_to",ntask_cont_to
 964         write (iout,*) "itask_cont_from",
 965      &    (itask_cont_from(i),i=1,ntask_cont_from)
 966         write (iout,*) "itask_cont_to",
 967      &    (itask_cont_to(i),i=1,ntask_cont_to)
 968         call flush(iout)
 969         write (iout,*) "iint_sent"
 970         do i=1,nat_sent
 971           ii=iat_sent(i)
 972           write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
 973      &      j=ielstart(ii),ielend(ii))
 974         enddo
 975         write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
 976      &    " iturn3_end",iturn3_end
 977         write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
 978      &      i=iturn3_start,iturn3_end)
 979         write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
 980      &    " iturn4_end",iturn4_end
 981         write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
 982      &      i=iturn4_start,iturn4_end)
 983         call flush(iout)
 984         endif
 985         call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
 986      &   ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
 987 c        write (iout,*) "Gather ntask_cont_from ended"
 988 c        call flush(iout)
 989         call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
 990      &   itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
 991      &   FG_COMM,IERR)
 992 c        write (iout,*) "Gather itask_cont_from ended"
 993 c        call flush(iout)
 994         call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
 995      &   1,MPI_INTEGER,king,FG_COMM,IERR)
 996 c        write (iout,*) "Gather ntask_cont_to ended"
 997 c        call flush(iout)
 998         call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
 999      &   itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
1000 c        write (iout,*) "Gather itask_cont_to ended"
1001 c        call flush(iout)
1002         if (fg_rank.eq.king) then
1003           write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
1004           do i=0,nfgtasks-1
1005             write (iout,'(20i4)') i,ntask_cont_from_all(i),
1006      &       (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
1007           enddo
1008           write (iout,*)
1009           call flush(iout)
1010           write (iout,*) "Contact send task map (proc, #tasks, tasks)"
1011           do i=0,nfgtasks-1
1012             write (iout,'(20i4)') i,ntask_cont_to_all(i),
1013      &       (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
1014           enddo
1015           write (iout,*)
1016           call flush(iout)
1017 C Check if every send will have a matching receive
1018           ncheck_to=0
1019           ncheck_from=0
1020           do i=0,nfgtasks-1
1021             ncheck_to=ncheck_to+ntask_cont_to_all(i)
1022             ncheck_from=ncheck_from+ntask_cont_from_all(i)
1023           enddo
1024           write (iout,*) "Control sums",ncheck_from,ncheck_to
1025           if (ncheck_from.ne.ncheck_to) then
1026             write (iout,*) "Error: #receive differs from #send."
1027             write (iout,*) "Terminating program...!"
1028             call flush(iout)
1029             flag=.false.
1030           else
1031             flag=.true.
1032             do i=0,nfgtasks-1
1033               do j=1,ntask_cont_to_all(i)
1034                 ii=itask_cont_to_all(j,i)
1035                 do k=1,ntask_cont_from_all(ii)
1036                   if (itask_cont_from_all(k,ii).eq.i) then
1037                     if(lprint)write(iout,*)"Matching send/receive",i,ii
1038                     exit
1039                   endif
1040                 enddo
1041                 if (k.eq.ntask_cont_from_all(ii)+1) then
1042                   flag=.false.
1043                   write (iout,*) "Error: send by",j," to",ii,
1044      &            " would have no matching receive"
1045                 endif
1046               enddo
1047             enddo
1048           endif
1049           if (.not.flag) then
1050             write (iout,*) "Unmatched sends; terminating program"
1051             call flush(iout)
1052           endif
1053         endif
1054         call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1055 c        write (iout,*) "flag broadcast ended flag=",flag
1056 c        call flush(iout)
1057         if (.not.flag) then
1058           call MPI_Finalize(IERROR)
1059           stop "Error in INIT_INT_TABLE: unmatched send/receive."
1060         endif
1061         call MPI_Comm_group(FG_COMM,fg_group,IERR)
1062 c        write (iout,*) "MPI_Comm_group ended"
1063 c        call flush(iout)
1064         call MPI_Group_incl(fg_group,ntask_cont_from+1,
1065      &    itask_cont_from(0),CONT_FROM_GROUP,IERR)
1066         call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1067      &    CONT_TO_GROUP,IERR)
1068         do i=1,nat_sent
1069           ii=iat_sent(i)
1070           iaux=4*(ielend(ii)-ielstart(ii)+1)
1071           call MPI_Group_translate_ranks(fg_group,iaux,
1072      &      iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1073      &      iint_sent_local(1,ielstart(ii),i),IERR )
1074 c          write (iout,*) "Ranks translated i=",i
1075 c          call flush(iout)
1076         enddo
1077         iaux=4*(iturn3_end-iturn3_start+1)
1078         call MPI_Group_translate_ranks(fg_group,iaux,
1079      &      iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1080      &      iturn3_sent_local(1,iturn3_start),IERR)
1081         iaux=4*(iturn4_end-iturn4_start+1)
1082         call MPI_Group_translate_ranks(fg_group,iaux,
1083      &      iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1084      &      iturn4_sent_local(1,iturn4_start),IERR)
1085         if (lprint) then
1086         write (iout,*) "iint_sent_local"
1087         do i=1,nat_sent
1088           ii=iat_sent(i)
1089           write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1090      &      j=ielstart(ii),ielend(ii))
1091           call flush(iout)
1092         enddo
1093         write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1094      &    " iturn3_end",iturn3_end
1095         write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1096      &      i=iturn3_start,iturn3_end)
1097         write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1098      &    " iturn4_end",iturn4_end
1099         write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1100      &      i=iturn4_start,iturn4_end)
1101         call flush(iout)
1102         endif
1103         call MPI_Group_free(fg_group,ierr)
1104         call MPI_Group_free(cont_from_group,ierr)
1105         call MPI_Group_free(cont_to_group,ierr)
1106 #endif
1107         call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1108         call MPI_Type_commit(MPI_UYZ,IERROR)
1109         call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1110      &    IERROR)
1111         call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1112         call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1113         call MPI_Type_commit(MPI_MU,IERROR)
1114         call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1115         call MPI_Type_commit(MPI_MAT1,IERROR)
1116         call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1117         call MPI_Type_commit(MPI_MAT2,IERROR)
1118         call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1119         call MPI_Type_commit(MPI_THET,IERROR)
1120         call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1121         call MPI_Type_commit(MPI_GAM,IERROR)
1122 #ifndef MATGATHER
1123 c 9/22/08 Derived types to send matrices which appear in correlation terms
1124         do i=0,nfgtasks-1
1125           if (ivec_count(i).eq.ivec_count(0)) then
1126             lentyp(i)=0
1127           else
1128             lentyp(i)=1
1129           endif
1130         enddo
1131         do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1132         if (ind_typ.eq.0) then
1133           ichunk=ivec_count(0)
1134         else
1135           ichunk=ivec_count(1)
1136         endif
1137 c        do i=1,4
1138 c          blocklengths(i)=4
1139 c        enddo
1140 c        displs(1)=0
1141 c        do i=2,4
1142 c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1143 c        enddo
1144 c        do i=1,4
1145 c          blocklengths(i)=blocklengths(i)*ichunk
1146 c        enddo
1147 c        write (iout,*) "blocklengths and displs"
1148 c        do i=1,4
1149 c          write (iout,*) i,blocklengths(i),displs(i)
1150 c        enddo
1151 c        call flush(iout)
1152 c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
1153 c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1154 c        call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1155 c        write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1156 c        do i=1,4
1157 c          blocklengths(i)=2
1158 c        enddo
1159 c        displs(1)=0
1160 c        do i=2,4
1161 c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1162 c        enddo
1163 c        do i=1,4
1164 c          blocklengths(i)=blocklengths(i)*ichunk
1165 c        enddo
1166 c        write (iout,*) "blocklengths and displs"
1167 c        do i=1,4
1168 c          write (iout,*) i,blocklengths(i),displs(i)
1169 c        enddo
1170 c        call flush(iout)
1171 c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
1172 c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1173 c        call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1174 c        write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1175         do i=1,8
1176           blocklengths(i)=2
1177         enddo
1178         displs(1)=0
1179         do i=2,8
1180           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1181         enddo
1182         do i=1,15
1183           blocklengths(i)=blocklengths(i)*ichunk
1184         enddo
1185         call MPI_Type_indexed(8,blocklengths,displs,
1186      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1187         call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1188         do i=1,8
1189           blocklengths(i)=4
1190         enddo
1191         displs(1)=0
1192         do i=2,8
1193           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1194         enddo
1195         do i=1,15
1196           blocklengths(i)=blocklengths(i)*ichunk
1197         enddo
1198         call MPI_Type_indexed(8,blocklengths,displs,
1199      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1200         call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1201         do i=1,6
1202           blocklengths(i)=4
1203         enddo
1204         displs(1)=0
1205         do i=2,6
1206           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1207         enddo
1208         do i=1,6
1209           blocklengths(i)=blocklengths(i)*ichunk
1210         enddo
1211         call MPI_Type_indexed(6,blocklengths,displs,
1212      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1213         call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1214         do i=1,2
1215           blocklengths(i)=8
1216         enddo
1217         displs(1)=0
1218         do i=2,2
1219           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1220         enddo
1221         do i=1,2
1222           blocklengths(i)=blocklengths(i)*ichunk
1223         enddo
1224         call MPI_Type_indexed(2,blocklengths,displs,
1225      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1226         call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1227         do i=1,4
1228           blocklengths(i)=1
1229         enddo
1230         displs(1)=0
1231         do i=2,4
1232           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1233         enddo
1234         do i=1,4
1235           blocklengths(i)=blocklengths(i)*ichunk
1236         enddo
1237         call MPI_Type_indexed(4,blocklengths,displs,
1238      &    MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1239         call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1240         enddo
1241 #endif
1242       endif
1243       iint_start=ivec_start+1
1244       iint_end=ivec_end+1
1245       do i=0,nfgtasks-1
1246           iint_count(i)=ivec_count(i)
1247           iint_displ(i)=ivec_displ(i)
1248           ivec_displ(i)=ivec_displ(i)-1
1249           iset_displ(i)=iset_displ(i)-1
1250           ithet_displ(i)=ithet_displ(i)-1
1251           iphi_displ(i)=iphi_displ(i)-1
1252           iphi1_displ(i)=iphi1_displ(i)-1
1253           ibond_displ(i)=ibond_displ(i)-1
1254       enddo
1255       if (nfgtasks.gt.1 .and. fg_rank.eq.king
1256      &     .and. (me.eq.0 .or. .not. out1file)) then
1257         write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1258         do i=0,nfgtasks-1
1259           write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1260      &      iset_count(i)
1261         enddo
1262         write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1263      &    " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1264         write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1265         do i=0,nfgtasks-1
1266           write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1267      &      iphi1_displ(i)
1268         enddo
1269         write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1270      & nele_int_tot,' electrostatic and ',nscp_int_tot,
1271      & ' SC-p interactions','were distributed among',nfgtasks,
1272      & ' fine-grain processors.'
1273       endif
1274 #else
1275       loc_start=2
1276       loc_end=nres-1
1277       ithet_start=3
1278       ithet_end=nres
1279       iturn3_start=nnt
1280       iturn3_end=nct-3
1281       iturn4_start=nnt
1282       iturn4_end=nct-4
1283       iphi_start=nnt+3
1284       iphi_end=nct
1285       iphi1_start=4
1286       iphi1_end=nres
1287       idihconstr_start=1
1288       idihconstr_end=ndih_constr
1289       ithetaconstr_start=1
1290       ithetaconstr_end=ntheta_constr
1291       iphid_start=iphi_start
1292       iphid_end=iphi_end-1
1293       itau_start=4
1294       itau_end=nres
1295       ibond_start=2
1296       ibond_end=nres-1
1297       ibondp_start=nnt
1298 C      ibondp_end=nct-1
1299       ibondp_end=nct
1300       isaxsg_start=nnt
1301       isaxsg_end=nct
1302       ivec_start=1
1303       ivec_end=nres-1
1304       iset_start=3
1305       iset_end=nres+1
1306       iint_start=2
1307       iint_end=nres-1
1308       ilip_start=1
1309       ilip_end=nres
1310 #endif
1311       return
1312       end
1313 #ifdef MPI
1314 c---------------------------------------------------------------------------
1315       subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1316       implicit none
1317       include "DIMENSIONS"
1318       include "COMMON.INTERACT"
1319       include "COMMON.SETUP"
1320       include "COMMON.IOUNITS"
1321       integer ii,jj,itask(4),ntask_cont_to,
1322      &itask_cont_to(0:max_fg_procs-1)
1323       logical flag
1324       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1325      & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1326       common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1327      & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1328      & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1329      &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1330      & ielend_all(maxres,0:max_fg_procs-1)
1331       integer iproc,isent,k,l
1332 c Determines whether to send interaction ii,jj to other processors; a given
1333 c interaction can be sent to at most 2 processors.
1334 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1335 c one processor, otherwise flag is unchanged from the input value.
1336       isent=0
1337       itask(1)=fg_rank
1338       itask(2)=fg_rank
1339       itask(3)=fg_rank
1340       itask(4)=fg_rank
1341 c      write (iout,*) "ii",ii," jj",jj
1342 c Loop over processors to check if anybody could need interaction ii,jj
1343       do iproc=0,fg_rank-1
1344 c Check if the interaction matches any turn3 at iproc
1345         do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1346           l=k+2
1347           if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1348      &   .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1349      &    then
1350 c            write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1351 c            call flush(iout)
1352             flag=.true.
1353             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1354      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1355               isent=isent+1
1356               itask(isent)=iproc
1357               call add_task(iproc,ntask_cont_to,itask_cont_to)
1358             endif
1359           endif
1360         enddo
1361 C Check if the interaction matches any turn4 at iproc
1362         do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1363           l=k+3
1364           if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1365      &   .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1366      &    then
1367 c            write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1368 c            call flush(iout)
1369             flag=.true.
1370             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1371      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1372               isent=isent+1
1373               itask(isent)=iproc
1374               call add_task(iproc,ntask_cont_to,itask_cont_to)
1375             endif
1376           endif
1377         enddo
1378         if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1379      &  iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1380           if (ielstart_all(ii-1,iproc).le.jj-1.and.
1381      &        ielend_all(ii-1,iproc).ge.jj-1) then
1382             flag=.true.
1383             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1384      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1385               isent=isent+1
1386               itask(isent)=iproc
1387               call add_task(iproc,ntask_cont_to,itask_cont_to)
1388             endif
1389           endif
1390           if (ielstart_all(ii-1,iproc).le.jj+1.and.
1391      &        ielend_all(ii-1,iproc).ge.jj+1) then
1392             flag=.true.
1393             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1394      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1395               isent=isent+1
1396               itask(isent)=iproc
1397               call add_task(iproc,ntask_cont_to,itask_cont_to)
1398             endif
1399           endif
1400         endif
1401       enddo
1402       return
1403       end
1404 c---------------------------------------------------------------------------
1405       subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1406       implicit none
1407       include "DIMENSIONS"
1408       include "COMMON.INTERACT"
1409       include "COMMON.SETUP"
1410       include "COMMON.IOUNITS"
1411       integer ii,jj,itask(2),ntask_cont_from,
1412      & itask_cont_from(0:max_fg_procs-1)
1413       logical flag
1414       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1415      & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1416       common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1417      & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1418      & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1419      &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1420      & ielend_all(maxres,0:max_fg_procs-1)
1421       integer iproc,k,l
1422       do iproc=fg_rank+1,nfgtasks-1
1423         do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1424           l=k+2
1425           if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1426      &   .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1427      &    then
1428 c            write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1429             call add_task(iproc,ntask_cont_from,itask_cont_from)
1430           endif
1431         enddo
1432         do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1433           l=k+3
1434           if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1435      &   .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1436      &    then
1437 c            write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1438             call add_task(iproc,ntask_cont_from,itask_cont_from)
1439           endif
1440         enddo
1441         if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1442           if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1443      &    then
1444             if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1445      &          jj+1.le.ielend_all(ii+1,iproc)) then
1446               call add_task(iproc,ntask_cont_from,itask_cont_from)
1447             endif
1448             if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1449      &          jj-1.le.ielend_all(ii+1,iproc)) then
1450               call add_task(iproc,ntask_cont_from,itask_cont_from)
1451             endif
1452           endif
1453           if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1454      &    then
1455             if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1456      &          jj-1.le.ielend_all(ii-1,iproc)) then
1457               call add_task(iproc,ntask_cont_from,itask_cont_from)
1458             endif
1459             if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1460      &          jj+1.le.ielend_all(ii-1,iproc)) then
1461                call add_task(iproc,ntask_cont_from,itask_cont_from)
1462             endif
1463           endif
1464         endif
1465       enddo
1466       return
1467       end
1468 c---------------------------------------------------------------------------
1469       subroutine add_task(iproc,ntask_cont,itask_cont)
1470       implicit none
1471       include "DIMENSIONS"
1472       integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1473       integer ii
1474       do ii=1,ntask_cont
1475         if (itask_cont(ii).eq.iproc) return
1476       enddo
1477       ntask_cont=ntask_cont+1
1478       itask_cont(ntask_cont)=iproc
1479       return
1480       end
1481 c---------------------------------------------------------------------------
1482       subroutine int_bounds(total_ints,lower_bound,upper_bound)
1483       implicit none
1484       include 'DIMENSIONS'
1485       include 'mpif.h'
1486       include 'COMMON.SETUP'
1487       integer total_ints,lower_bound,upper_bound
1488       integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1489       integer i,nint,nexcess
1490       nint=total_ints/nfgtasks
1491       do i=1,nfgtasks
1492         int4proc(i-1)=nint
1493       enddo
1494       nexcess=total_ints-nint*nfgtasks
1495       do i=1,nexcess
1496         int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1497       enddo
1498       lower_bound=0
1499       do i=0,fg_rank-1
1500         lower_bound=lower_bound+int4proc(i)
1501       enddo
1502       upper_bound=lower_bound+int4proc(fg_rank)
1503       lower_bound=lower_bound+1
1504       return
1505       end
1506 c---------------------------------------------------------------------------
1507       subroutine int_bounds8(total_ints,lower_bound,upper_bound)
1508       implicit none
1509       include 'DIMENSIONS'
1510       include 'mpif.h'
1511       include 'COMMON.SETUP'
1512       integer*8 total_ints,lower_bound,upper_bound,nint
1513       integer*8 int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1514       integer i,nexcess
1515       nint=total_ints/nfgtasks
1516       do i=1,nfgtasks
1517         int4proc(i-1)=nint
1518       enddo
1519       nexcess=total_ints-nint*nfgtasks
1520       do i=1,nexcess
1521         int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1522       enddo
1523       lower_bound=0
1524       do i=0,fg_rank-1
1525         lower_bound=lower_bound+int4proc(i)
1526       enddo
1527       upper_bound=lower_bound+int4proc(fg_rank)
1528       lower_bound=lower_bound+1
1529       return
1530       end
1531 c---------------------------------------------------------------------------
1532       subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1533       implicit none
1534       include 'DIMENSIONS'
1535       include 'mpif.h'
1536       include 'COMMON.SETUP'
1537       integer total_ints,lower_bound,upper_bound
1538       integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1539       integer i,nint,nexcess
1540       nint=total_ints/nfgtasks1
1541       do i=1,nfgtasks1
1542         int4proc(i-1)=nint
1543       enddo
1544       nexcess=total_ints-nint*nfgtasks1
1545       do i=1,nexcess
1546         int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1547       enddo
1548       lower_bound=0
1549       do i=0,fg_rank1-1
1550         lower_bound=lower_bound+int4proc(i)
1551       enddo
1552       upper_bound=lower_bound+int4proc(fg_rank1)
1553       lower_bound=lower_bound+1
1554       return
1555       end
1556 c---------------------------------------------------------------------------
1557       subroutine int_partition(int_index,lower_index,upper_index,atom,
1558      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1559       implicit none
1560       include 'DIMENSIONS'
1561       include 'COMMON.IOUNITS'
1562       integer int_index,lower_index,upper_index,atom,at_start,at_end,
1563      & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1564       logical lprn
1565       lprn=.false.
1566       if (lprn) write (iout,*) 'int_index=',int_index
1567       int_index_old=int_index
1568       int_index=int_index+last_atom-first_atom+1
1569       if (lprn)
1570      &   write (iout,*) 'int_index=',int_index,
1571      &               ' int_index_old',int_index_old,
1572      &               ' lower_index=',lower_index,
1573      &               ' upper_index=',upper_index,
1574      &               ' atom=',atom,' first_atom=',first_atom,
1575      &               ' last_atom=',last_atom
1576       if (int_index.ge.lower_index) then
1577         int_gr=int_gr+1
1578         if (at_start.eq.0) then
1579           at_start=atom
1580           jat_start=first_atom-1+lower_index-int_index_old
1581         else
1582           jat_start=first_atom
1583         endif
1584         if (lprn) write (iout,*) 'jat_start',jat_start
1585         if (int_index.ge.upper_index) then
1586           at_end=atom
1587           jat_end=first_atom-1+upper_index-int_index_old
1588           return1
1589         else
1590           jat_end=last_atom
1591         endif
1592         if (lprn) write (iout,*) 'jat_end',jat_end
1593       endif
1594       return
1595       end
1596 c---------------------------------------------------------------------------
1597       subroutine int_partition8(int_index,lower_index,upper_index,atom,
1598      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1599       implicit none
1600       include 'DIMENSIONS'
1601       include 'COMMON.IOUNITS'
1602       integer*8 int_index,lower_index,upper_index
1603       integer atom,at_start,at_end,
1604      & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1605       logical lprn
1606       lprn=.false.
1607       if (lprn) write (iout,*) 'int_index=',int_index
1608       int_index_old=int_index
1609       int_index=int_index+last_atom-first_atom+1
1610       if (lprn)
1611      &   write (iout,*) 'int_index=',int_index,
1612      &               ' int_index_old',int_index_old,
1613      &               ' lower_index=',lower_index,
1614      &               ' upper_index=',upper_index,
1615      &               ' atom=',atom,' first_atom=',first_atom,
1616      &               ' last_atom=',last_atom
1617       if (int_index.ge.lower_index) then
1618         int_gr=int_gr+1
1619         if (at_start.eq.0) then
1620           at_start=atom
1621           jat_start=first_atom-1+lower_index-int_index_old
1622         else
1623           jat_start=first_atom
1624         endif
1625         if (lprn) write (iout,*) 'jat_start',jat_start
1626         if (int_index.ge.upper_index) then
1627           at_end=atom
1628           jat_end=first_atom-1+upper_index-int_index_old
1629           return1
1630         else
1631           jat_end=last_atom
1632         endif
1633         if (lprn) write (iout,*) 'jat_end',jat_end
1634       endif
1635       return
1636       end
1637 #endif
1638 c------------------------------------------------------------------------------
1639       subroutine hpb_partition
1640       implicit none
1641       include 'DIMENSIONS'
1642 #ifdef MPI
1643       include 'mpif.h'
1644 #endif
1645       include 'COMMON.SBRIDGE'
1646       include 'COMMON.IOUNITS'
1647       include 'COMMON.SETUP'
1648 #ifdef MPI
1649       call int_bounds(nhpb,link_start,link_end)
1650       write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1651      &  ' absolute rank',MyRank,
1652      &  ' nhpb',nhpb,' link_start=',link_start,
1653      &  ' link_end',link_end
1654 #else
1655       link_start=1
1656       link_end=nhpb
1657 #endif
1658       return
1659       end
1660 c------------------------------------------------------------------------------
1661       subroutine homology_partition
1662       implicit none
1663       include 'DIMENSIONS'
1664 #ifdef MPI
1665       include 'mpif.h'
1666 #endif
1667       include 'COMMON.SBRIDGE'
1668       include 'COMMON.IOUNITS'
1669       include 'COMMON.SETUP'
1670       include 'COMMON.CONTROL'
1671       include 'COMMON.INTERACT'
1672       include 'COMMON.HOMOLOGY'
1673 cd      write(iout,*)"homology_partition: lim_odl=",lim_odl,
1674 cd     &   " lim_dih",lim_dih
1675 #ifdef MPI
1676       if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1677       call int_bounds(lim_odl,link_start_homo,link_end_homo)
1678       call int_bounds(lim_dih,idihconstr_start_homo,
1679      &  idihconstr_end_homo)
1680       idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1681       idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1682       if (me.eq.king .or. .not. out1file)
1683      &  write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1684      &  ' absolute rank',MyRank,
1685      &  ' lim_odl',lim_odl,' link_start=',link_start_homo,
1686      &  ' link_end',link_end_homo,' lim_dih',lim_dih,
1687      &  ' idihconstr_start_homo',idihconstr_start_homo,
1688      &  ' idihconstr_end_homo',idihconstr_end_homo
1689 #else
1690       write (iout,*) "Not MPI"
1691       link_start_homo=1
1692       link_end_homo=lim_odl
1693       idihconstr_start_homo=nnt+3
1694       idihconstr_end_homo=lim_dih+nnt-1+3
1695       write (iout,*)
1696      &  ' lim_odl',lim_odl,' link_start=',link_start_homo,
1697      &  ' link_end',link_end_homo,' lim_dih',lim_dih,
1698      &  ' idihconstr_start_homo',idihconstr_start_homo,
1699      &  ' idihconstr_end_homo',idihconstr_end_homo
1700 #endif
1701       return
1702       end
1703 c------------------------------------------------------------------------------
1704       subroutine NMRpeak_partition
1705       implicit none
1706       include 'DIMENSIONS'
1707 #ifdef MPI
1708       include 'mpif.h'
1709 #endif
1710       include 'COMMON.SBRIDGE'
1711       include 'COMMON.IOUNITS'
1712       include 'COMMON.SETUP'
1713 #ifdef MPI
1714       call int_bounds(npeak,link_start_peak,link_end_peak)
1715       write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1716      &  ' absolute rank',MyRank,
1717      &  ' npeak',npeak,' link_start_peak=',link_start_peak,
1718      &  ' link_end_peak',link_end_peak
1719 #else
1720       link_start_peak=1
1721       link_end_peak=npeak
1722 #endif
1723       return
1724       end