source/unres/src-5hdiag-tmp/initialize_p.F

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