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

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