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       include 'COMMON.CORRMAT'
 450       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
 451      & iturn4_end_all,iatel_s_all,
 452      & iatel_e_all,ielstart_all,ielend_all,ntask_cont_from_all,
 453      & itask_cont_from_all,ntask_cont_to_all,itask_cont_to_all,
 454      & n_sc_int_tot,my_sc_inds,my_sc_inde,ind_sctint,ind_scint_old
 455       common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
 456      & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
 457      & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
 458      &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
 459      & ielend_all(maxres,0:max_fg_procs-1),
 460      & ntask_cont_from_all(0:max_fg_procs-1),
 461      & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
 462      & ntask_cont_to_all(0:max_fg_procs-1),
 463      & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
 464       integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
 465       logical scheck,lprint,flag
 466       integer i,j,k,ii,jj,iint,npept,nele_int_tot,ind_eleint,ind_scint,
 467      & my_ele_inds,my_ele_inde,ind_eleint_old,nele_int_tot_vdw,
 468      & my_ele_inds_vdw,my_ele_inde_vdw,ind_eleint_vdw,ijunk,
 469      & ind_eleint_vdw_old,nscp_int_tot,my_scp_inds,my_scp_inde,
 470      & ind_scpint,ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,
 471      & iaux,ind_typ,ncheck_from,ncheck_to,ichunk
 472 #ifdef MPI
 473       integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
 474      & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
 475 C... Determine the numbers of start and end SC-SC interaction
 476 C... to deal with by current processor.
 477 #ifdef FOURBODY
 478       do i=0,nfgtasks-1
 479         itask_cont_from(i)=fg_rank
 480         itask_cont_to(i)=fg_rank
 481       enddo
 482 #endif
 483       lprint=energy_dec
 484       if (lprint)
 485      &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
 486       n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
 487       call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
 488       if (lprint)
 489      &  write (iout,*) 'Processor',fg_rank,' CG group',kolor,
 490      &  ' absolute rank',MyRank,
 491      &  ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
 492      &  ' my_sc_inde',my_sc_inde
 493       ind_sctint=0
 494       iatsc_s=0
 495       iatsc_e=0
 496 #endif
 497 c      lprint=.false.
 498       do i=1,maxres
 499         nint_gr(i)=0
 500         nscp_gr(i)=0
 501         do j=1,maxint_gr
 502           istart(i,1)=0
 503           iend(i,1)=0
 504           ielstart(i)=0
 505           ielend(i)=0
 506           iscpstart(i,1)=0
 507           iscpend(i,1)=0
 508         enddo
 509       enddo
 510       ind_scint=0
 511       ind_scint_old=0
 512 cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 513 cd   &   (ihpb(i),jhpb(i),i=1,nss)
 514       do i=nnt,nct-1
 515         scheck=.false.
 516         if (dyn_ss) goto 10
 517         do ii=1,nss
 518           if (ihpb(ii).eq.i+nres) then
 519             scheck=.true.
 520             jj=jhpb(ii)-nres
 521             goto 10
 522           endif
 523         enddo
 524    10   continue
 525 cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 526         if (scheck) then
 527           if (jj.eq.i+1) then
 528 #ifdef MPI
 529 c            write (iout,*) 'jj=i+1'
 530             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 531      & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 532 #else
 533             nint_gr(i)=1
 534             istart(i,1)=i+2
 535             iend(i,1)=nct
 536 #endif
 537           else if (jj.eq.nct) then
 538 #ifdef MPI
 539 c            write (iout,*) 'jj=nct'
 540             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 541      &  iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 542 #else
 543             nint_gr(i)=1
 544             istart(i,1)=i+1
 545             iend(i,1)=nct-1
 546 #endif
 547           else
 548 #ifdef MPI
 549             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 550      & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 551             ii=nint_gr(i)+1
 552             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 553      & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
 554 #else
 555             nint_gr(i)=2
 556             istart(i,1)=i+1
 557             iend(i,1)=jj-1
 558             istart(i,2)=jj+1
 559             iend(i,2)=nct
 560 #endif
 561           endif
 562         else
 563 #ifdef MPI
 564           call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 565      &    iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 566 #else
 567           nint_gr(i)=1
 568           istart(i,1)=i+1
 569           iend(i,1)=nct
 570           ind_scint=ind_scint+nct-i
 571 #endif
 572         endif
 573 #ifdef MPI
 574         ind_scint_old=ind_scint
 575 #endif
 576       enddo
 577    12 continue
 578 #ifndef MPI
 579       iatsc_s=nnt
 580       iatsc_e=nct-1
 581 #endif
 582       if (iatsc_s.eq.0) iatsc_s=1
 583 #ifdef MPI
 584       if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
 585      &   ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
 586 #endif
 587       if (lprint) then
 588       write (iout,'(a)') 'Interaction array:'
 589       do i=iatsc_s,iatsc_e
 590         write (iout,'(i3,2(2x,2i3))')
 591      & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 592       enddo
 593       endif
 594       ispp=4
 595 #ifdef MPI
 596 C Now partition the electrostatic-interaction array
 597       npept=nct-nnt
 598       nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
 599       call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
 600       if (lprint)
 601      & write (*,*) 'Processor',fg_rank,' CG group',kolor,
 602      &  ' absolute rank',MyRank,
 603      &  ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
 604      &               ' my_ele_inde',my_ele_inde
 605       iatel_s=0
 606       iatel_e=0
 607       ind_eleint=0
 608       ind_eleint_old=0
 609       do i=nnt,nct-3
 610         ijunk=0
 611         call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
 612      &    iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
 613       enddo ! i
 614    13 continue
 615       if (iatel_s.eq.0) iatel_s=1
 616       nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
 617 c      write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
 618       call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
 619 c      write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
 620 c     & " my_ele_inde_vdw",my_ele_inde_vdw
 621       ind_eleint_vdw=0
 622       ind_eleint_vdw_old=0
 623       iatel_s_vdw=0
 624       iatel_e_vdw=0
 625       do i=nnt,nct-3
 626         ijunk=0
 627         call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
 628      &    my_ele_inde_vdw,i,
 629      &    iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
 630      &    ielend_vdw(i),*15)
 631 c        write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
 632 c     &   " ielend_vdw",ielend_vdw(i)
 633       enddo ! i
 634       if (iatel_s_vdw.eq.0) iatel_s_vdw=1
 635    15 continue
 636 #else
 637       iatel_s=nnt
 638       iatel_e=nct-5
 639       do i=iatel_s,iatel_e
 640         ielstart(i)=i+4
 641         ielend(i)=nct-1
 642       enddo
 643       iatel_s_vdw=nnt
 644       iatel_e_vdw=nct-3
 645       do i=iatel_s_vdw,iatel_e_vdw
 646         ielstart_vdw(i)=i+2
 647         ielend_vdw(i)=nct-1
 648       enddo
 649 #endif
 650       if (lprint) then
 651         write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
 652      &  ' absolute rank',MyRank
 653         write (iout,*) 'Electrostatic interaction array:'
 654         do i=iatel_s,iatel_e
 655           write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
 656         enddo
 657       endif ! lprint
 658 c     iscp=3
 659       iscp=2
 660 C Partition the SC-p interaction array
 661 #ifdef MPI
 662       nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
 663       call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
 664       if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
 665      &  ' absolute rank',myrank,
 666      &  ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
 667      &               ' my_scp_inde',my_scp_inde
 668       iatscp_s=0
 669       iatscp_e=0
 670       ind_scpint=0
 671       ind_scpint_old=0
 672       do i=nnt,nct-1
 673         if (i.lt.nnt+iscp) then
 674 cd        write (iout,*) 'i.le.nnt+iscp'
 675           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 676      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
 677      &      iscpend(i,1),*14)
 678         else if (i.gt.nct-iscp) then
 679 cd        write (iout,*) 'i.gt.nct-iscp'
 680           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 681      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 682      &      iscpend(i,1),*14)
 683         else
 684           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 685      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 686      &      iscpend(i,1),*14)
 687           ii=nscp_gr(i)+1
 688           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 689      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
 690      &      iscpend(i,ii),*14)
 691         endif
 692       enddo ! i
 693    14 continue
 694 #else
 695       iatscp_s=nnt
 696       iatscp_e=nct-1
 697       do i=nnt,nct-1
 698         if (i.lt.nnt+iscp) then
 699           nscp_gr(i)=1
 700           iscpstart(i,1)=i+iscp
 701           iscpend(i,1)=nct
 702         elseif (i.gt.nct-iscp) then
 703           nscp_gr(i)=1
 704           iscpstart(i,1)=nnt
 705           iscpend(i,1)=i-iscp
 706         else
 707           nscp_gr(i)=2
 708           iscpstart(i,1)=nnt
 709           iscpend(i,1)=i-iscp
 710           iscpstart(i,2)=i+iscp
 711           iscpend(i,2)=nct
 712         endif
 713       enddo ! i
 714 #endif
 715       if (iatscp_s.eq.0) iatscp_s=1
 716       if (lprint) then
 717         write (iout,'(a)') 'SC-p interaction array:'
 718         do i=iatscp_s,iatscp_e
 719           write (iout,'(i3,2(2x,2i3))')
 720      &         i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 721         enddo
 722       endif ! lprint
 723 C Partition local interactions
 724 #ifdef MPI
 725       call int_bounds(nres-2,loc_start,loc_end)
 726       loc_start=loc_start+1
 727       loc_end=loc_end+1
 728       call int_bounds(nres-2,ithet_start,ithet_end)
 729       call int_bounds(nsaxs,isaxs_start,isaxs_end)
 730       write (iout,*) me," isaxs_start",isaxs_start,
 731      &  " isaxs_end",isaxs_end
 732       ithet_start=ithet_start+2
 733       ithet_end=ithet_end+2
 734       call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
 735       iturn3_start=iturn3_start+nnt
 736       iphi_start=iturn3_start+2
 737       iturn3_end=iturn3_end+nnt
 738       iphi_end=iturn3_end+2
 739       iturn3_start=iturn3_start-1
 740       iturn3_end=iturn3_end-1
 741       call int_bounds(nres-3,itau_start,itau_end)
 742       itau_start=itau_start+3
 743       itau_end=itau_end+3
 744       call int_bounds(nres-3,iphi1_start,iphi1_end)
 745       iphi1_start=iphi1_start+3
 746       iphi1_end=iphi1_end+3
 747       call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
 748       iturn4_start=iturn4_start+nnt
 749       iphid_start=iturn4_start+2
 750       iturn4_end=iturn4_end+nnt
 751       iphid_end=iturn4_end+2
 752       iturn4_start=iturn4_start-1
 753       iturn4_end=iturn4_end-1
 754       call int_bounds(nres-2,ibond_start,ibond_end)
 755       ibond_start=ibond_start+1
 756       ibond_end=ibond_end+1
 757       call int_bounds(nct-nnt,ibondp_start,ibondp_end)
 758       ibondp_start=ibondp_start+nnt
 759       ibondp_end=ibondp_end+nnt
 760       call int_bounds(nres,ilip_start,ilip_end)
 761 c      ilip_start=ilip_start
 762       call int_bounds1(nres-1,ivec_start,ivec_end)
 763 c      print *,"Processor",myrank,fg_rank,fg_rank1,
 764 c     &  " ivec_start",ivec_start," ivec_end",ivec_end
 765       iset_start=loc_start+2
 766       iset_end=loc_end+2
 767       if (ndih_constr.eq.0) then
 768         idihconstr_start=1
 769         idihconstr_end=0
 770       else
 771         call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
 772       endif
 773       if (ntheta_constr.eq.0) then
 774         ithetaconstr_start=1
 775         ithetaconstr_end=0
 776       else
 777         call int_bounds
 778      &  (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
 779       endif
 780 c      nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 781 c      nlen=nres-nnt+1
 782       nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 783       nlen=nres-nnt+1
 784       call int_bounds(nsumgrad,ngrad_start,ngrad_end)
 785       igrad_start=((2*nlen+1)
 786      &    -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
 787       jgrad_start(igrad_start)=
 788      &    ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
 789      &    +igrad_start
 790       jgrad_end(igrad_start)=nres
 791       igrad_end=((2*nlen+1)
 792      &    -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
 793       if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
 794       jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
 795      &    +igrad_end
 796       do i=igrad_start+1,igrad_end-1
 797         jgrad_start(i)=i+1
 798         jgrad_end(i)=nres
 799       enddo
 800       if (lprint) then
 801         write (*,*) 'Processor:',fg_rank,' CG group',kolor,
 802      & ' absolute rank',myrank,
 803      & ' loc_start',loc_start,' loc_end',loc_end,
 804      & ' ithet_start',ithet_start,' ithet_end',ithet_end,
 805      & ' iphi_start',iphi_start,' iphi_end',iphi_end,
 806      & ' iphid_start',iphid_start,' iphid_end',iphid_end,
 807      & ' ibond_start',ibond_start,' ibond_end',ibond_end,
 808      & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
 809      & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
 810      & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
 811      & ' ivec_start',ivec_start,' ivec_end',ivec_end,
 812      & ' iset_start',iset_start,' iset_end',iset_end,
 813      & ' idihconstr_start',idihconstr_start,' idihconstr_end',
 814      &   idihconstr_end,
 815      & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end',
 816      &   ithetaconstr_end
 817
 818        write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
 819      &   igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
 820      &   ' ngrad_end',ngrad_end
 821        do i=igrad_start,igrad_end
 822          write(*,*) 'Processor:',fg_rank,myrank,i,
 823      &    jgrad_start(i),jgrad_end(i)
 824        enddo
 825       endif
 826       if (nfgtasks.gt.1) then
 827         call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
 828      &    MPI_INTEGER,FG_COMM1,IERROR)
 829         iaux=ivec_end-ivec_start+1
 830         call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
 831      &    MPI_INTEGER,FG_COMM1,IERROR)
 832         call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
 833      &    MPI_INTEGER,FG_COMM,IERROR)
 834         iaux=iset_end-iset_start+1
 835         call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
 836      &    MPI_INTEGER,FG_COMM,IERROR)
 837         call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
 838      &    MPI_INTEGER,FG_COMM,IERROR)
 839         iaux=ibond_end-ibond_start+1
 840         call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
 841      &    MPI_INTEGER,FG_COMM,IERROR)
 842         call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
 843      &    MPI_INTEGER,FG_COMM,IERROR)
 844         iaux=ithet_end-ithet_start+1
 845         call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
 846      &    MPI_INTEGER,FG_COMM,IERROR)
 847         call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
 848      &    MPI_INTEGER,FG_COMM,IERROR)
 849         iaux=iphi_end-iphi_start+1
 850         call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
 851      &    MPI_INTEGER,FG_COMM,IERROR)
 852         call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
 853      &    MPI_INTEGER,FG_COMM,IERROR)
 854         iaux=iphi1_end-iphi1_start+1
 855         call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
 856      &    MPI_INTEGER,FG_COMM,IERROR)
 857         do i=0,max_fg_procs-1
 858           do j=1,maxres
 859             ielstart_all(j,i)=0
 860             ielend_all(j,i)=0
 861           enddo
 862         enddo
 863         call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
 864      &    iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 865         call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
 866      &    iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 867         call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
 868      &    iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 869         call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
 870      &    iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 871         call MPI_Allgather(iatel_s,1,MPI_INTEGER,
 872      &    iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 873         call MPI_Allgather(iatel_e,1,MPI_INTEGER,
 874      &    iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 875         call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
 876      &    ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
 877         call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
 878      &    ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
 879         if (lprint) then
 880         write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
 881         write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
 882         write (iout,*) "iturn3_start_all",
 883      &    (iturn3_start_all(i),i=0,nfgtasks-1)
 884         write (iout,*) "iturn3_end_all",
 885      &    (iturn3_end_all(i),i=0,nfgtasks-1)
 886         write (iout,*) "iturn4_start_all",
 887      &    (iturn4_start_all(i),i=0,nfgtasks-1)
 888         write (iout,*) "iturn4_end_all",
 889      &    (iturn4_end_all(i),i=0,nfgtasks-1)
 890         write (iout,*) "The ielstart_all array"
 891         do i=nnt,nct
 892           write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
 893         enddo
 894         write (iout,*) "The ielend_all array"
 895         do i=nnt,nct
 896           write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
 897         enddo
 898         call flush(iout)
 899         endif
 900 #ifdef FOURBODY
 901         ntask_cont_from=0
 902         ntask_cont_to=0
 903         itask_cont_from(0)=fg_rank
 904         itask_cont_to(0)=fg_rank
 905         flag=.false.
 906         do ii=iturn3_start,iturn3_end
 907           call add_int(ii,ii+2,iturn3_sent(1,ii),
 908      &                 ntask_cont_to,itask_cont_to,flag)
 909         enddo
 910         do ii=iturn4_start,iturn4_end
 911           call add_int(ii,ii+3,iturn4_sent(1,ii),
 912      &                 ntask_cont_to,itask_cont_to,flag)
 913         enddo
 914         do ii=iturn3_start,iturn3_end
 915           call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
 916         enddo
 917         do ii=iturn4_start,iturn4_end
 918           call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
 919         enddo
 920         if (lprint) then
 921         write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
 922      &   " ntask_cont_to",ntask_cont_to
 923         write (iout,*) "itask_cont_from",
 924      &    (itask_cont_from(i),i=1,ntask_cont_from)
 925         write (iout,*) "itask_cont_to",
 926      &    (itask_cont_to(i),i=1,ntask_cont_to)
 927         call flush(iout)
 928         endif
 929 c        write (iout,*) "Loop forward"
 930 c        call flush(iout)
 931         do i=iatel_s,iatel_e
 932 c          write (iout,*) "from loop i=",i
 933 c          call flush(iout)
 934           do j=ielstart(i),ielend(i)
 935             call add_int_from(i,j,ntask_cont_from,itask_cont_from)
 936           enddo
 937         enddo
 938 c        write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
 939 c     &     " iatel_e",iatel_e
 940 c        call flush(iout)
 941         nat_sent=0
 942         do i=iatel_s,iatel_e
 943 c          write (iout,*) "i",i," ielstart",ielstart(i),
 944 c     &      " ielend",ielend(i)
 945 c          call flush(iout)
 946           flag=.false.
 947           do j=ielstart(i),ielend(i)
 948             call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
 949      &                   itask_cont_to,flag)
 950           enddo
 951           if (flag) then
 952             nat_sent=nat_sent+1
 953             iat_sent(nat_sent)=i
 954           endif
 955         enddo
 956         if (lprint) then
 957         write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
 958      &   " ntask_cont_to",ntask_cont_to
 959         write (iout,*) "itask_cont_from",
 960      &    (itask_cont_from(i),i=1,ntask_cont_from)
 961         write (iout,*) "itask_cont_to",
 962      &    (itask_cont_to(i),i=1,ntask_cont_to)
 963         call flush(iout)
 964         write (iout,*) "iint_sent"
 965         do i=1,nat_sent
 966           ii=iat_sent(i)
 967           write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
 968      &      j=ielstart(ii),ielend(ii))
 969         enddo
 970         write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
 971      &    " iturn3_end",iturn3_end
 972         write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
 973      &      i=iturn3_start,iturn3_end)
 974         write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
 975      &    " iturn4_end",iturn4_end
 976         write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
 977      &      i=iturn4_start,iturn4_end)
 978         call flush(iout)
 979         endif
 980         call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
 981      &   ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
 982 c        write (iout,*) "Gather ntask_cont_from ended"
 983 c        call flush(iout)
 984         call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
 985      &   itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
 986      &   FG_COMM,IERR)
 987 c        write (iout,*) "Gather itask_cont_from ended"
 988 c        call flush(iout)
 989         call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
 990      &   1,MPI_INTEGER,king,FG_COMM,IERR)
 991 c        write (iout,*) "Gather ntask_cont_to ended"
 992 c        call flush(iout)
 993         call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
 994      &   itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
 995 c        write (iout,*) "Gather itask_cont_to ended"
 996 c        call flush(iout)
 997         if (fg_rank.eq.king) then
 998           write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
 999           do i=0,nfgtasks-1
1000             write (iout,'(20i4)') i,ntask_cont_from_all(i),
1001      &       (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
1002           enddo
1003           write (iout,*)
1004           call flush(iout)
1005           write (iout,*) "Contact send task map (proc, #tasks, tasks)"
1006           do i=0,nfgtasks-1
1007             write (iout,'(20i4)') i,ntask_cont_to_all(i),
1008      &       (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
1009           enddo
1010           write (iout,*)
1011           call flush(iout)
1012 C Check if every send will have a matching receive
1013           ncheck_to=0
1014           ncheck_from=0
1015           do i=0,nfgtasks-1
1016             ncheck_to=ncheck_to+ntask_cont_to_all(i)
1017             ncheck_from=ncheck_from+ntask_cont_from_all(i)
1018           enddo
1019           write (iout,*) "Control sums",ncheck_from,ncheck_to
1020           if (ncheck_from.ne.ncheck_to) then
1021             write (iout,*) "Error: #receive differs from #send."
1022             write (iout,*) "Terminating program...!"
1023             call flush(iout)
1024             flag=.false.
1025           else
1026             flag=.true.
1027             do i=0,nfgtasks-1
1028               do j=1,ntask_cont_to_all(i)
1029                 ii=itask_cont_to_all(j,i)
1030                 do k=1,ntask_cont_from_all(ii)
1031                   if (itask_cont_from_all(k,ii).eq.i) then
1032                     if(lprint)write(iout,*)"Matching send/receive",i,ii
1033                     exit
1034                   endif
1035                 enddo
1036                 if (k.eq.ntask_cont_from_all(ii)+1) then
1037                   flag=.false.
1038                   write (iout,*) "Error: send by",j," to",ii,
1039      &            " would have no matching receive"
1040                 endif
1041               enddo
1042             enddo
1043           endif
1044           if (.not.flag) then
1045             write (iout,*) "Unmatched sends; terminating program"
1046             call flush(iout)
1047           endif
1048         endif
1049         call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1050 c        write (iout,*) "flag broadcast ended flag=",flag
1051 c        call flush(iout)
1052         if (.not.flag) then
1053           call MPI_Finalize(IERROR)
1054           stop "Error in INIT_INT_TABLE: unmatched send/receive."
1055         endif
1056         call MPI_Comm_group(FG_COMM,fg_group,IERR)
1057 c        write (iout,*) "MPI_Comm_group ended"
1058 c        call flush(iout)
1059         call MPI_Group_incl(fg_group,ntask_cont_from+1,
1060      &    itask_cont_from(0),CONT_FROM_GROUP,IERR)
1061         call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
1062      &    CONT_TO_GROUP,IERR)
1063         do i=1,nat_sent
1064           ii=iat_sent(i)
1065           iaux=4*(ielend(ii)-ielstart(ii)+1)
1066           call MPI_Group_translate_ranks(fg_group,iaux,
1067      &      iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
1068      &      iint_sent_local(1,ielstart(ii),i),IERR )
1069 c          write (iout,*) "Ranks translated i=",i
1070 c          call flush(iout)
1071         enddo
1072         iaux=4*(iturn3_end-iturn3_start+1)
1073         call MPI_Group_translate_ranks(fg_group,iaux,
1074      &      iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
1075      &      iturn3_sent_local(1,iturn3_start),IERR)
1076         iaux=4*(iturn4_end-iturn4_start+1)
1077         call MPI_Group_translate_ranks(fg_group,iaux,
1078      &      iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
1079      &      iturn4_sent_local(1,iturn4_start),IERR)
1080         if (lprint) then
1081         write (iout,*) "iint_sent_local"
1082         do i=1,nat_sent
1083           ii=iat_sent(i)
1084           write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
1085      &      j=ielstart(ii),ielend(ii))
1086           call flush(iout)
1087         enddo
1088         write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
1089      &    " iturn3_end",iturn3_end
1090         write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
1091      &      i=iturn3_start,iturn3_end)
1092         write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
1093      &    " iturn4_end",iturn4_end
1094         write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
1095      &      i=iturn4_start,iturn4_end)
1096         call flush(iout)
1097         endif
1098         call MPI_Group_free(fg_group,ierr)
1099         call MPI_Group_free(cont_from_group,ierr)
1100         call MPI_Group_free(cont_to_group,ierr)
1101 #endif
1102         call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1103         call MPI_Type_commit(MPI_UYZ,IERROR)
1104         call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
1105      &    IERROR)
1106         call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1107         call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1108         call MPI_Type_commit(MPI_MU,IERROR)
1109         call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1110         call MPI_Type_commit(MPI_MAT1,IERROR)
1111         call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1112         call MPI_Type_commit(MPI_MAT2,IERROR)
1113         call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1114         call MPI_Type_commit(MPI_THET,IERROR)
1115         call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1116         call MPI_Type_commit(MPI_GAM,IERROR)
1117 #ifndef MATGATHER
1118 c 9/22/08 Derived types to send matrices which appear in correlation terms
1119         do i=0,nfgtasks-1
1120           if (ivec_count(i).eq.ivec_count(0)) then
1121             lentyp(i)=0
1122           else
1123             lentyp(i)=1
1124           endif
1125         enddo
1126         do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1127         if (ind_typ.eq.0) then
1128           ichunk=ivec_count(0)
1129         else
1130           ichunk=ivec_count(1)
1131         endif
1132 c        do i=1,4
1133 c          blocklengths(i)=4
1134 c        enddo
1135 c        displs(1)=0
1136 c        do i=2,4
1137 c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1138 c        enddo
1139 c        do i=1,4
1140 c          blocklengths(i)=blocklengths(i)*ichunk
1141 c        enddo
1142 c        write (iout,*) "blocklengths and displs"
1143 c        do i=1,4
1144 c          write (iout,*) i,blocklengths(i),displs(i)
1145 c        enddo
1146 c        call flush(iout)
1147 c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
1148 c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1149 c        call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1150 c        write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1151 c        do i=1,4
1152 c          blocklengths(i)=2
1153 c        enddo
1154 c        displs(1)=0
1155 c        do i=2,4
1156 c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1157 c        enddo
1158 c        do i=1,4
1159 c          blocklengths(i)=blocklengths(i)*ichunk
1160 c        enddo
1161 c        write (iout,*) "blocklengths and displs"
1162 c        do i=1,4
1163 c          write (iout,*) i,blocklengths(i),displs(i)
1164 c        enddo
1165 c        call flush(iout)
1166 c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
1167 c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1168 c        call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1169 c        write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1170         do i=1,8
1171           blocklengths(i)=2
1172         enddo
1173         displs(1)=0
1174         do i=2,8
1175           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1176         enddo
1177         do i=1,15
1178           blocklengths(i)=blocklengths(i)*ichunk
1179         enddo
1180         call MPI_Type_indexed(8,blocklengths,displs,
1181      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1182         call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1183         do i=1,8
1184           blocklengths(i)=4
1185         enddo
1186         displs(1)=0
1187         do i=2,8
1188           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1189         enddo
1190         do i=1,15
1191           blocklengths(i)=blocklengths(i)*ichunk
1192         enddo
1193         call MPI_Type_indexed(8,blocklengths,displs,
1194      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1195         call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1196         do i=1,6
1197           blocklengths(i)=4
1198         enddo
1199         displs(1)=0
1200         do i=2,6
1201           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1202         enddo
1203         do i=1,6
1204           blocklengths(i)=blocklengths(i)*ichunk
1205         enddo
1206         call MPI_Type_indexed(6,blocklengths,displs,
1207      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1208         call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1209         do i=1,2
1210           blocklengths(i)=8
1211         enddo
1212         displs(1)=0
1213         do i=2,2
1214           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1215         enddo
1216         do i=1,2
1217           blocklengths(i)=blocklengths(i)*ichunk
1218         enddo
1219         call MPI_Type_indexed(2,blocklengths,displs,
1220      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1221         call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1222         do i=1,4
1223           blocklengths(i)=1
1224         enddo
1225         displs(1)=0
1226         do i=2,4
1227           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1228         enddo
1229         do i=1,4
1230           blocklengths(i)=blocklengths(i)*ichunk
1231         enddo
1232         call MPI_Type_indexed(4,blocklengths,displs,
1233      &    MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1234         call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1235         enddo
1236 #endif
1237       endif
1238       iint_start=ivec_start+1
1239       iint_end=ivec_end+1
1240       do i=0,nfgtasks-1
1241           iint_count(i)=ivec_count(i)
1242           iint_displ(i)=ivec_displ(i)
1243           ivec_displ(i)=ivec_displ(i)-1
1244           iset_displ(i)=iset_displ(i)-1
1245           ithet_displ(i)=ithet_displ(i)-1
1246           iphi_displ(i)=iphi_displ(i)-1
1247           iphi1_displ(i)=iphi1_displ(i)-1
1248           ibond_displ(i)=ibond_displ(i)-1
1249       enddo
1250       if (nfgtasks.gt.1 .and. fg_rank.eq.king
1251      &     .and. (me.eq.0 .or. .not. out1file)) then
1252         write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1253         do i=0,nfgtasks-1
1254           write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
1255      &      iset_count(i)
1256         enddo
1257         write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
1258      &    " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1259         write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1260         do i=0,nfgtasks-1
1261           write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
1262      &      iphi1_displ(i)
1263         enddo
1264         write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
1265      & nele_int_tot,' electrostatic and ',nscp_int_tot,
1266      & ' SC-p interactions','were distributed among',nfgtasks,
1267      & ' fine-grain processors.'
1268       endif
1269 #else
1270       loc_start=2
1271       loc_end=nres-1
1272       ithet_start=3
1273       ithet_end=nres
1274       iturn3_start=nnt
1275       iturn3_end=nct-3
1276       iturn4_start=nnt
1277       iturn4_end=nct-4
1278       iphi_start=nnt+3
1279       iphi_end=nct
1280       iphi1_start=4
1281       iphi1_end=nres
1282       idihconstr_start=1
1283       idihconstr_end=ndih_constr
1284       ithetaconstr_start=1
1285       ithetaconstr_end=ntheta_constr
1286       iphid_start=iphi_start
1287       iphid_end=iphi_end-1
1288       itau_start=4
1289       itau_end=nres
1290       ibond_start=2
1291       ibond_end=nres-1
1292       ibondp_start=nnt
1293 C      ibondp_end=nct-1
1294       ibondp_end=nct
1295       isaxsg_start=nnt
1296       isaxsg_end=nct
1297       ivec_start=1
1298       ivec_end=nres-1
1299       iset_start=3
1300       iset_end=nres+1
1301       iint_start=2
1302       iint_end=nres-1
1303       ilip_start=1
1304       ilip_end=nres
1305 #endif
1306       return
1307       end
1308 #ifdef MPI
1309 c---------------------------------------------------------------------------
1310       subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1311       implicit none
1312       include "DIMENSIONS"
1313       include "COMMON.INTERACT"
1314       include "COMMON.SETUP"
1315       include "COMMON.IOUNITS"
1316       integer ii,jj,itask(4),ntask_cont_to,
1317      &itask_cont_to(0:max_fg_procs-1)
1318       logical flag
1319       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1320      & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1321       common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1322      & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1323      & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1324      &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1325      & ielend_all(maxres,0:max_fg_procs-1)
1326       integer iproc,isent,k,l
1327 c Determines whether to send interaction ii,jj to other processors; a given
1328 c interaction can be sent to at most 2 processors.
1329 c Sets flag=.true. if interaction ii,jj needs to be sent to at least
1330 c one processor, otherwise flag is unchanged from the input value.
1331       isent=0
1332       itask(1)=fg_rank
1333       itask(2)=fg_rank
1334       itask(3)=fg_rank
1335       itask(4)=fg_rank
1336 c      write (iout,*) "ii",ii," jj",jj
1337 c Loop over processors to check if anybody could need interaction ii,jj
1338       do iproc=0,fg_rank-1
1339 c Check if the interaction matches any turn3 at iproc
1340         do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1341           l=k+2
1342           if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1343      &   .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1344      &    then
1345 c            write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1346 c            call flush(iout)
1347             flag=.true.
1348             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1349      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1350               isent=isent+1
1351               itask(isent)=iproc
1352               call add_task(iproc,ntask_cont_to,itask_cont_to)
1353             endif
1354           endif
1355         enddo
1356 C Check if the interaction matches any turn4 at iproc
1357         do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1358           l=k+3
1359           if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
1360      &   .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
1361      &    then
1362 c            write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1363 c            call flush(iout)
1364             flag=.true.
1365             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1366      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1367               isent=isent+1
1368               itask(isent)=iproc
1369               call add_task(iproc,ntask_cont_to,itask_cont_to)
1370             endif
1371           endif
1372         enddo
1373         if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
1374      &  iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1375           if (ielstart_all(ii-1,iproc).le.jj-1.and.
1376      &        ielend_all(ii-1,iproc).ge.jj-1) then
1377             flag=.true.
1378             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1379      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1380               isent=isent+1
1381               itask(isent)=iproc
1382               call add_task(iproc,ntask_cont_to,itask_cont_to)
1383             endif
1384           endif
1385           if (ielstart_all(ii-1,iproc).le.jj+1.and.
1386      &        ielend_all(ii-1,iproc).ge.jj+1) then
1387             flag=.true.
1388             if (iproc.ne.itask(1).and.iproc.ne.itask(2)
1389      &        .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1390               isent=isent+1
1391               itask(isent)=iproc
1392               call add_task(iproc,ntask_cont_to,itask_cont_to)
1393             endif
1394           endif
1395         endif
1396       enddo
1397       return
1398       end
1399 c---------------------------------------------------------------------------
1400       subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1401       implicit none
1402       include "DIMENSIONS"
1403       include "COMMON.INTERACT"
1404       include "COMMON.SETUP"
1405       include "COMMON.IOUNITS"
1406       integer ii,jj,itask(2),ntask_cont_from,
1407      & itask_cont_from(0:max_fg_procs-1)
1408       logical flag
1409       integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
1410      & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1411       common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
1412      & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
1413      & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
1414      &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
1415      & ielend_all(maxres,0:max_fg_procs-1)
1416       integer iproc,k,l
1417       do iproc=fg_rank+1,nfgtasks-1
1418         do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1419           l=k+2
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,*)"turn3 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         do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1428           l=k+3
1429           if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
1430      &   .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
1431      &    then
1432 c            write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1433             call add_task(iproc,ntask_cont_from,itask_cont_from)
1434           endif
1435         enddo
1436         if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1437           if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
1438      &    then
1439             if (jj+1.ge.ielstart_all(ii+1,iproc).and.
1440      &          jj+1.le.ielend_all(ii+1,iproc)) then
1441               call add_task(iproc,ntask_cont_from,itask_cont_from)
1442             endif
1443             if (jj-1.ge.ielstart_all(ii+1,iproc).and.
1444      &          jj-1.le.ielend_all(ii+1,iproc)) then
1445               call add_task(iproc,ntask_cont_from,itask_cont_from)
1446             endif
1447           endif
1448           if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
1449      &    then
1450             if (jj-1.ge.ielstart_all(ii-1,iproc).and.
1451      &          jj-1.le.ielend_all(ii-1,iproc)) then
1452               call add_task(iproc,ntask_cont_from,itask_cont_from)
1453             endif
1454             if (jj+1.ge.ielstart_all(ii-1,iproc).and.
1455      &          jj+1.le.ielend_all(ii-1,iproc)) then
1456                call add_task(iproc,ntask_cont_from,itask_cont_from)
1457             endif
1458           endif
1459         endif
1460       enddo
1461       return
1462       end
1463 c---------------------------------------------------------------------------
1464       subroutine add_task(iproc,ntask_cont,itask_cont)
1465       implicit none
1466       include "DIMENSIONS"
1467       integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
1468       integer ii
1469       do ii=1,ntask_cont
1470         if (itask_cont(ii).eq.iproc) return
1471       enddo
1472       ntask_cont=ntask_cont+1
1473       itask_cont(ntask_cont)=iproc
1474       return
1475       end
1476 c---------------------------------------------------------------------------
1477       subroutine int_bounds(total_ints,lower_bound,upper_bound)
1478       implicit none
1479       include 'DIMENSIONS'
1480       include 'mpif.h'
1481       include 'COMMON.SETUP'
1482       integer total_ints,lower_bound,upper_bound
1483       integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1484       integer i,nint,nexcess
1485       nint=total_ints/nfgtasks
1486       do i=1,nfgtasks
1487         int4proc(i-1)=nint
1488       enddo
1489       nexcess=total_ints-nint*nfgtasks
1490       do i=1,nexcess
1491         int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
1492       enddo
1493       lower_bound=0
1494       do i=0,fg_rank-1
1495         lower_bound=lower_bound+int4proc(i)
1496       enddo
1497       upper_bound=lower_bound+int4proc(fg_rank)
1498       lower_bound=lower_bound+1
1499       return
1500       end
1501 c---------------------------------------------------------------------------
1502       subroutine int_bounds1(total_ints,lower_bound,upper_bound)
1503       implicit none
1504       include 'DIMENSIONS'
1505       include 'mpif.h'
1506       include 'COMMON.SETUP'
1507       integer total_ints,lower_bound,upper_bound
1508       integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
1509       integer i,nint,nexcess
1510       nint=total_ints/nfgtasks1
1511       do i=1,nfgtasks1
1512         int4proc(i-1)=nint
1513       enddo
1514       nexcess=total_ints-nint*nfgtasks1
1515       do i=1,nexcess
1516         int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
1517       enddo
1518       lower_bound=0
1519       do i=0,fg_rank1-1
1520         lower_bound=lower_bound+int4proc(i)
1521       enddo
1522       upper_bound=lower_bound+int4proc(fg_rank1)
1523       lower_bound=lower_bound+1
1524       return
1525       end
1526 c---------------------------------------------------------------------------
1527       subroutine int_partition(int_index,lower_index,upper_index,atom,
1528      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1529       implicit none
1530       include 'DIMENSIONS'
1531       include 'COMMON.IOUNITS'
1532       integer int_index,lower_index,upper_index,atom,at_start,at_end,
1533      & first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1534       logical lprn
1535       lprn=.false.
1536       if (lprn) write (iout,*) 'int_index=',int_index
1537       int_index_old=int_index
1538       int_index=int_index+last_atom-first_atom+1
1539       if (lprn)
1540      &   write (iout,*) 'int_index=',int_index,
1541      &               ' int_index_old',int_index_old,
1542      &               ' lower_index=',lower_index,
1543      &               ' upper_index=',upper_index,
1544      &               ' atom=',atom,' first_atom=',first_atom,
1545      &               ' last_atom=',last_atom
1546       if (int_index.ge.lower_index) then
1547         int_gr=int_gr+1
1548         if (at_start.eq.0) then
1549           at_start=atom
1550           jat_start=first_atom-1+lower_index-int_index_old
1551         else
1552           jat_start=first_atom
1553         endif
1554         if (lprn) write (iout,*) 'jat_start',jat_start
1555         if (int_index.ge.upper_index) then
1556           at_end=atom
1557           jat_end=first_atom-1+upper_index-int_index_old
1558           return1
1559         else
1560           jat_end=last_atom
1561         endif
1562         if (lprn) write (iout,*) 'jat_end',jat_end
1563       endif
1564       return
1565       end
1566 #endif
1567 c------------------------------------------------------------------------------
1568       subroutine hpb_partition
1569       implicit none
1570       include 'DIMENSIONS'
1571 #ifdef MPI
1572       include 'mpif.h'
1573 #endif
1574       include 'COMMON.SBRIDGE'
1575       include 'COMMON.IOUNITS'
1576       include 'COMMON.SETUP'
1577 #ifdef MPI
1578       call int_bounds(nhpb,link_start,link_end)
1579       write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1580      &  ' absolute rank',MyRank,
1581      &  ' nhpb',nhpb,' link_start=',link_start,
1582      &  ' link_end',link_end
1583 #else
1584       link_start=1
1585       link_end=nhpb
1586 #endif
1587       return
1588       end
1589 c------------------------------------------------------------------------------
1590       subroutine homology_partition
1591       implicit none
1592       include 'DIMENSIONS'
1593 #ifdef MPI
1594       include 'mpif.h'
1595 #endif
1596       include 'COMMON.SBRIDGE'
1597       include 'COMMON.IOUNITS'
1598       include 'COMMON.SETUP'
1599       include 'COMMON.CONTROL'
1600       include 'COMMON.INTERACT'
1601       include 'COMMON.HOMOLOGY'
1602 cd      write(iout,*)"homology_partition: lim_odl=",lim_odl,
1603 cd     &   " lim_dih",lim_dih
1604 #ifdef MPI
1605       if (me.eq.king .or. .not. out1file) write (iout,*) "MPI"
1606       call int_bounds(lim_odl,link_start_homo,link_end_homo)
1607       call int_bounds(lim_dih,idihconstr_start_homo,
1608      &  idihconstr_end_homo)
1609       idihconstr_start_homo=idihconstr_start_homo+nnt-1+3
1610       idihconstr_end_homo=idihconstr_end_homo+nnt-1+3
1611       if (me.eq.king .or. .not. out1file)
1612      &  write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1613      &  ' absolute rank',MyRank,
1614      &  ' lim_odl',lim_odl,' link_start=',link_start_homo,
1615      &  ' link_end',link_end_homo,' lim_dih',lim_dih,
1616      &  ' idihconstr_start_homo',idihconstr_start_homo,
1617      &  ' idihconstr_end_homo',idihconstr_end_homo
1618 #else
1619       write (iout,*) "Not MPI"
1620       link_start_homo=1
1621       link_end_homo=lim_odl
1622       idihconstr_start_homo=nnt+3
1623       idihconstr_end_homo=lim_dih+nnt-1+3
1624       write (iout,*)
1625      &  ' lim_odl',lim_odl,' link_start=',link_start_homo,
1626      &  ' link_end',link_end_homo,' lim_dih',lim_dih,
1627      &  ' idihconstr_start_homo',idihconstr_start_homo,
1628      &  ' idihconstr_end_homo',idihconstr_end_homo
1629 #endif
1630       return
1631       end
1632 c------------------------------------------------------------------------------
1633       subroutine NMRpeak_partition
1634       implicit none
1635       include 'DIMENSIONS'
1636 #ifdef MPI
1637       include 'mpif.h'
1638 #endif
1639       include 'COMMON.SBRIDGE'
1640       include 'COMMON.IOUNITS'
1641       include 'COMMON.SETUP'
1642 #ifdef MPI
1643       call int_bounds(npeak,link_start_peak,link_end_peak)
1644       write (iout,*) 'Processor',fg_rank,' CG group',kolor,
1645      &  ' absolute rank',MyRank,
1646      &  ' npeak',npeak,' link_start_peak=',link_start_peak,
1647      &  ' link_end_peak',link_end_peak
1648 #else
1649       link_start_peak=1
1650       link_end_peak=npeak
1651 #endif
1652       return
1653       end