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

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