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

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