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