source/wham/src-M/initialize_p.F

   1       subroutine initialize
   2 C
   3 C Define constants and zero out tables.
   4 C
   5       implicit real*8 (a-h,o-z)
   6       include 'DIMENSIONS'
   7       include 'DIMENSIONS.ZSCOPT'
   8 #ifdef MPI
   9       include 'mpif.h'
  10 #endif
  11       include 'COMMON.IOUNITS'
  12       include 'COMMON.CHAIN'
  13       include 'COMMON.INTERACT'
  14       include 'COMMON.GEO'
  15       include 'COMMON.LOCAL'
  16       include 'COMMON.TORSION'
  17       include 'COMMON.FFIELD'
  18       include 'COMMON.SBRIDGE'
  19       include 'COMMON.MINIM'
  20       include 'COMMON.DERIV'
  21       include "COMMON.WEIGHTS"
  22       include "COMMON.NAMES"
  23       include "COMMON.TIME1"
  24 C
  25 C The following is just to define auxiliary variables used in angle conversion
  26 C
  27       pi=4.0D0*datan(1.0D0)
  28       dwapi=2.0D0*pi
  29       dwapi3=dwapi/3.0D0
  30       pipol=0.5D0*pi
  31       deg2rad=pi/180.0D0
  32       rad2deg=1.0D0/deg2rad
  33       angmin=10.0D0*deg2rad
  34 C
  35 C Define I/O units.
  36 C
  37       inp=    1
  38       iout=   2
  39       ipdbin= 3
  40       ipdb=   7
  41       imol2=  4
  42       igeom=  8
  43       intin=  9
  44       ithep= 11
  45       irotam=12
  46       itorp= 13
  47       itordp= 23
  48       ielep= 14
  49       isidep=15
  50       isidep1=22
  51       iscpp=25
  52       icbase=16
  53       ifourier=20
  54       istat= 17
  55       ientin=18
  56       ientout=19
  57       ibond=28
  58       isccor=29
  59 C
  60 C WHAM files
  61 C
  62       ihist=30
  63       iweight=31
  64       izsc=32
  65       itube=45
  66 C Lipidic input file for parameters range 60-79
  67       iliptranpar=60
  68 C
  69 C Set default weights of the energy terms.
  70 C
  71       wlong=1.0D0
  72       welec=1.0D0
  73       wtor =1.0D0
  74       wang =1.0D0
  75       wscloc=1.0D0
  76       wstrain=1.0D0
  77 C
  78 C Zero out tables.
  79 C
  80       ndih_constr=0
  81       do i=1,maxres2
  82         do j=1,3
  83           c(j,i)=0.0D0
  84           dc(j,i)=0.0D0
  85         enddo
  86       enddo
  87       do i=1,maxres
  88         do j=1,3
  89           xloc(j,i)=0.0D0
  90         enddo
  91       enddo
  92       do i=1,ntyp
  93         do j=1,ntyp
  94           aa_lip(i,j)=0.0D0
  95           bb_lip(i,j)=0.0D0
  96           aa_aq(i,j)=0.0D0
  97           bb_aq(i,j)=0.0D0
  98           augm(i,j)=0.0D0
  99           sigma(i,j)=0.0D0
 100           r0(i,j)=0.0D0
 101           chi(i,j)=0.0D0
 102         enddo
 103         do j=1,2
 104           bad(i,j)=0.0D0
 105         enddo
 106         chip(i)=0.0D0
 107         alp(i)=0.0D0
 108         sigma0(i)=0.0D0
 109         sigii(i)=0.0D0
 110         rr0(i)=0.0D0
 111         a0thet(i)=0.0D0
 112         do j=1,2
 113          do ichir1=-1,1
 114           do ichir2=-1,1
 115           athet(j,i,ichir1,ichir2)=0.0D0
 116           bthet(j,i,ichir1,ichir2)=0.0D0
 117           enddo
 118          enddo
 119         enddo
 120         do j=0,3
 121           polthet(j,i)=0.0D0
 122         enddo
 123         do j=1,3
 124           gthet(j,i)=0.0D0
 125         enddo
 126         theta0(i)=0.0D0
 127         sig0(i)=0.0D0
 128         sigc0(i)=0.0D0
 129         do j=1,maxlob
 130           bsc(j,i)=0.0D0
 131           do k=1,3
 132             censc(k,j,i)=0.0D0
 133           enddo
 134           do k=1,3
 135             do l=1,3
 136               gaussc(l,k,j,i)=0.0D0
 137             enddo
 138           enddo
 139           nlob(i)=0
 140         enddo
 141       enddo
 142       nlob(ntyp1)=0
 143       dsc(ntyp1)=0.0D0
 144       do i=-maxtor,maxtor
 145         itortyp(i)=0
 146        do iblock=1,2
 147         do j=-maxtor,maxtor
 148           do k=1,maxterm
 149             v1(k,j,i,iblock)=0.0D0
 150             v2(k,j,i,iblock)=0.0D0
 151           enddo
 152         enddo
 153         enddo
 154       enddo
 155       do iblock=1,2
 156        do i=-maxtor,maxtor
 157         do j=-maxtor,maxtor
 158          do k=-maxtor,maxtor
 159           do l=1,maxtermd_1
 160             v1c(1,l,i,j,k,iblock)=0.0D0
 161             v1s(1,l,i,j,k,iblock)=0.0D0
 162             v1c(2,l,i,j,k,iblock)=0.0D0
 163             v1s(2,l,i,j,k,iblock)=0.0D0
 164           enddo !l
 165           do l=1,maxtermd_2
 166            do m=1,maxtermd_2
 167             v2c(m,l,i,j,k,iblock)=0.0D0
 168             v2s(m,l,i,j,k,iblock)=0.0D0
 169            enddo !m
 170           enddo !l
 171         enddo !k
 172        enddo !j
 173       enddo !i
 174       enddo !iblock
 175       do i=1,maxres
 176         itype(i)=0
 177         itel(i)=0
 178       enddo
 179 C Initialize the bridge arrays
 180       ns=0
 181       nss=0
 182       nhpb=0
 183       do i=1,maxss
 184         iss(i)=0
 185       enddo
 186       do i=1,maxdim
 187         dhpb(i)=0.0D0
 188       enddo
 189       do i=1,maxres
 190         ihpb(i)=0
 191         jhpb(i)=0
 192         dyn_ss_mask(i)=.false.
 193       enddo
 194 C
 195 C Initialize timing.
 196 C
 197       call set_timers
 198 C
 199 C Initialize variables used in minimization.
 200 C
 201 c     maxfun=5000
 202 c     maxit=2000
 203       maxfun=500
 204       maxit=200
 205       tolf=1.0D-2
 206       rtolf=5.0D-4
 207 C
 208 C Initialize the variables responsible for the mode of gradient storage.
 209 C
 210       nfl=0
 211       icg=1
 212       do i=1,14
 213         do j=1,14
 214           if (print_order(i).eq.j) then
 215             iw(print_order(i))=j
 216             goto 1121
 217           endif
 218         enddo
 219 1121    continue
 220       enddo
 221       calc_grad=.false.
 222 C Set timers and counters for the respective routines
 223       t_func = 0.0d0
 224       t_grad = 0.0d0
 225       t_fhel = 0.0d0
 226       t_fbet = 0.0d0
 227       t_ghel = 0.0d0
 228       t_gbet = 0.0d0
 229       t_viol = 0.0d0
 230       t_gviol = 0.0d0
 231       n_func = 0
 232       n_grad = 0
 233       n_fhel = 0
 234       n_fbet = 0
 235       n_ghel = 0
 236       n_gbet = 0
 237       n_viol = 0
 238       n_gviol = 0
 239       n_map = 0
 240 #ifndef SPLITELE
 241       nprint_ene=nprint_ene-1
 242 #endif
 243       return
 244       end
 245 c-------------------------------------------------------------------------
 246       block data nazwy
 247       implicit real*8 (a-h,o-z)
 248       include 'DIMENSIONS'
 249       include 'DIMENSIONS.ZSCOPT'
 250       include 'COMMON.NAMES'
 251       include 'COMMON.WEIGHTS'
 252       include 'COMMON.FFIELD'
 253       include 'COMMON.SHIELD'
 254       data restyp /
 255      &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL',
 256      & 'DSG','DGN','DSN','DTH',
 257      &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER',
 258      &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
 259      &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ',
 260      &'AIB','ABU','D'/
 261       data onelet /
 262      &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g',
 263      &'a','y','w','v','l','i','f','m','c','x',
 264      &'C','M','F','I','L','V','W','Y','A','G','T',
 265      &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/
 266       data potname /'LJ','LJK','BP','GB','GBV'/
 267       data ename /
 268      &   "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
 269      &   "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
 270      &   "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP",
 271      &   "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T","ELIPTRAN",
 272      &   "EAFM","ETHETC","EMPTY","ETUBE"/
 273       data wname /
 274      &   "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
 275      &   "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
 276      &   "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC",
 277      &   "WLIPTRAN","WAFM","WTHETC","WSHIELD","WTUBE"/
 278       data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,
 279      &    1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,1.0d0,
 280      &    0.0d0,0.0,0.0d0,0.0d0,0.0d0,0.0d0,0.0d0/
 281       data nprint_ene /22/
 282       data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19,
 283      &  16,15,17,20,21,24,22,23,1,25/
 284       end
 285 c---------------------------------------------------------------------------
 286       subroutine init_int_table
 287       implicit real*8 (a-h,o-z)
 288       include 'DIMENSIONS'
 289       include 'DIMENSIONS.ZSCOPT'
 290 #ifdef MPI
 291       include 'mpif.h'
 292 #endif
 293 #ifdef MP
 294       include 'COMMON.INFO'
 295 #endif
 296       include 'COMMON.CHAIN'
 297       include 'COMMON.INTERACT'
 298       include 'COMMON.LOCAL'
 299       include 'COMMON.SBRIDGE'
 300       include 'COMMON.IOUNITS'
 301       logical scheck,lprint
 302 #ifdef MPL
 303       integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
 304      & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
 305 C... Determine the numbers of start and end SC-SC interaction
 306 C... to deal with by current processor.
 307       lprint=.false.
 308       if (lprint)
 309      &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
 310       n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
 311       MyRank=MyID-(MyGroup-1)*fgProcs
 312       call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
 313       if (lprint)
 314      &  write (iout,*) 'Processor',MyID,' MyRank',MyRank,
 315      &  ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
 316      &  ' my_sc_inde',my_sc_inde
 317       ind_sctint=0
 318       iatsc_s=0
 319       iatsc_e=0
 320 #endif
 321       lprint=.false.
 322       do i=1,maxres
 323         nint_gr(i)=0
 324         nscp_gr(i)=0
 325         do j=1,maxint_gr
 326           istart(i,1)=0
 327           iend(i,1)=0
 328           ielstart(i)=0
 329           ielend(i)=0
 330           iscpstart(i,1)=0
 331           iscpend(i,1)=0
 332         enddo
 333       enddo
 334       ind_scint=0
 335       ind_scint_old=0
 336 cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 337 cd   &   (ihpb(i),jhpb(i),i=1,nss)
 338       do i=nnt,nct-1
 339         scheck=.false.
 340         if (dyn_ss) goto 10
 341         do ii=1,nss
 342           if (ihpb(ii).eq.i+nres) then
 343             scheck=.true.
 344             jj=jhpb(ii)-nres
 345             goto 10
 346           endif
 347         enddo
 348    10   continue
 349 cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 350         if (scheck) then
 351           if (jj.eq.i+1) then
 352 #ifdef MPL
 353             write (iout,*) 'jj=i+1'
 354             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 355      & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 356 #else
 357             nint_gr(i)=1
 358             istart(i,1)=i+2
 359             iend(i,1)=nct
 360 #endif
 361           else if (jj.eq.nct) then
 362 #ifdef MPL
 363             write (iout,*) 'jj=nct'
 364             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 365      &  iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 366 #else
 367             nint_gr(i)=1
 368             istart(i,1)=i+1
 369             iend(i,1)=nct-1
 370 #endif
 371           else
 372 #ifdef MPL
 373             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 374      & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 375             ii=nint_gr(i)+1
 376             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 377      & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
 378 #else
 379             nint_gr(i)=2
 380             istart(i,1)=i+1
 381             iend(i,1)=jj-1
 382             istart(i,2)=jj+1
 383             iend(i,2)=nct
 384 #endif
 385           endif
 386         else
 387 #ifdef MPL
 388           call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 389      &    iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 390 #else
 391           nint_gr(i)=1
 392           istart(i,1)=i+1
 393           iend(i,1)=nct
 394           ind_scint=int_scint+nct-i
 395 #endif
 396         endif
 397 #ifdef MPL
 398         ind_scint_old=ind_scint
 399 #endif
 400       enddo
 401    12 continue
 402 #ifndef MPL
 403       iatsc_s=nnt
 404       iatsc_e=nct-1
 405 #endif
 406 #ifdef MPL
 407       if (lprint) then
 408         write (iout,*) 'Processor',MyID,' Group',MyGroup
 409         write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
 410       endif
 411 #endif
 412       if (lprint) then
 413       write (iout,'(a)') 'Interaction array:'
 414       do i=iatsc_s,iatsc_e
 415         write (iout,'(i3,2(2x,2i3))')
 416      & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 417       enddo
 418       endif
 419       ispp=2
 420 #ifdef MPL
 421 C Now partition the electrostatic-interaction array
 422       npept=nct-nnt
 423       nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
 424       call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
 425       if (lprint)
 426      & write (iout,*) 'Processor',MyID,' MyRank',MyRank,
 427      &  ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
 428      &               ' my_ele_inde',my_ele_inde
 429       iatel_s=0
 430       iatel_e=0
 431       ind_eleint=0
 432       ind_eleint_old=0
 433       do i=nnt,nct-3
 434         ijunk=0
 435         call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
 436      &    iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
 437       enddo ! i
 438    13 continue
 439 #else
 440       iatel_s=nnt
 441       iatel_e=nct-3
 442       do i=iatel_s,iatel_e
 443         ielstart(i)=i+2
 444         ielend(i)=nct-1
 445       enddo
 446 #endif
 447       if (lprint) then
 448         write (iout,'(a)') 'Electrostatic interaction array:'
 449         do i=iatel_s,iatel_e
 450           write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
 451         enddo
 452       endif ! lprint
 453 c     iscp=3
 454       iscp=2
 455 C Partition the SC-p interaction array
 456 #ifdef MPL
 457       nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
 458       call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
 459       if (lprint)
 460      & write (iout,*) 'Processor',MyID,' MyRank',MyRank,
 461      &  ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
 462      &               ' my_scp_inde',my_scp_inde
 463       iatscp_s=0
 464       iatscp_e=0
 465       ind_scpint=0
 466       ind_scpint_old=0
 467       do i=nnt,nct-1
 468         if (i.lt.nnt+iscp) then
 469 cd        write (iout,*) 'i.le.nnt+iscp'
 470           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 471      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
 472      &      iscpend(i,1),*14)
 473         else if (i.gt.nct-iscp) then
 474 cd        write (iout,*) 'i.gt.nct-iscp'
 475           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 476      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 477      &      iscpend(i,1),*14)
 478         else
 479           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 480      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 481      &      iscpend(i,1),*14)
 482           ii=nscp_gr(i)+1
 483           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 484      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
 485      &      iscpend(i,ii),*14)
 486         endif
 487       enddo ! i
 488    14 continue
 489 #else
 490       iatscp_s=nnt
 491       iatscp_e=nct-1
 492       do i=nnt,nct-1
 493         if (i.lt.nnt+iscp) then
 494           nscp_gr(i)=1
 495           iscpstart(i,1)=i+iscp
 496           iscpend(i,1)=nct
 497         elseif (i.gt.nct-iscp) then
 498           nscp_gr(i)=1
 499           iscpstart(i,1)=nnt
 500           iscpend(i,1)=i-iscp
 501         else
 502           nscp_gr(i)=2
 503           iscpstart(i,1)=nnt
 504           iscpend(i,1)=i-iscp
 505           iscpstart(i,2)=i+iscp
 506           iscpend(i,2)=nct
 507         endif
 508       enddo ! i
 509 #endif
 510       if (lprint) then
 511         write (iout,'(a)') 'SC-p interaction array:'
 512         do i=iatscp_s,iatscp_e
 513           write (iout,'(i3,2(2x,2i3))')
 514      &         i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 515         enddo
 516       endif ! lprint
 517 C Partition local interactions
 518 #ifdef MPL
 519       call int_bounds(nres-2,loc_start,loc_end)
 520       loc_start=loc_start+1
 521       loc_end=loc_end+1
 522       call int_bounds(nres-2,ithet_start,ithet_end)
 523       ithet_start=ithet_start+2
 524       ithet_end=ithet_end+2
 525       call int_bounds(nct-nnt-2,iphi_start,iphi_end)
 526       iphi_start=iphi_start+nnt+2
 527       iphi_end=iphi_end+nnt+2
 528       call int_bounds(nres-3,itau_start,itau_end)
 529       itau_start=itau_start+3
 530       itau_end=itau_end+3
 531       call int_bounds(nres-1,itube_start,itube_end)
 532       itube_start=itube_start
 533       itube_end=itube_end
 534       if (lprint) then
 535         write (iout,*) 'Processor:',MyID,
 536      & ' loc_start',loc_start,' loc_end',loc_end,
 537      & ' ithet_start',ithet_start,' ithet_end',ithet_end,
 538      & ' iphi_start',iphi_start,' iphi_end',iphi_end
 539         write (*,*) 'Processor:',MyID,
 540      & ' loc_start',loc_start,' loc_end',loc_end,
 541      & ' ithet_start',ithet_start,' ithet_end',ithet_end,
 542      & ' iphi_start',iphi_start,' iphi_end',iphi_end
 543       endif
 544       if (fgprocs.gt.1 .and. MyID.eq.BossID) then
 545         write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
 546      & nele_int_tot,' electrostatic and ',nscp_int_tot,
 547      & ' SC-p interactions','were distributed among',fgprocs,
 548      & ' fine-grain processors.'
 549       endif
 550 #else
 551       loc_start=2
 552       loc_end=nres-1
 553       ithet_start=3
 554       ithet_end=nres
 555       iphi_start=nnt+3
 556       iphi_end=nct
 557       itau_start=4
 558       itau_end=nres
 559       itube_start=1
 560       itube_end=nres-1
 561 #endif
 562       return
 563       end
 564 c---------------------------------------------------------------------------
 565       subroutine int_partition(int_index,lower_index,upper_index,atom,
 566      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
 567       implicit real*8 (a-h,o-z)
 568       include 'DIMENSIONS'
 569       include 'COMMON.IOUNITS'
 570       integer int_index,lower_index,upper_index,atom,at_start,at_end,
 571      & first_atom,last_atom,int_gr,jat_start,jat_end
 572       logical lprn
 573       lprn=.false.
 574       if (lprn) write (iout,*) 'int_index=',int_index
 575       int_index_old=int_index
 576       int_index=int_index+last_atom-first_atom+1
 577       if (lprn)
 578      &   write (iout,*) 'int_index=',int_index,
 579      &               ' int_index_old',int_index_old,
 580      &               ' lower_index=',lower_index,
 581      &               ' upper_index=',upper_index,
 582      &               ' atom=',atom,' first_atom=',first_atom,
 583      &               ' last_atom=',last_atom
 584       if (int_index.ge.lower_index) then
 585         int_gr=int_gr+1
 586         if (at_start.eq.0) then
 587           at_start=atom
 588           jat_start=first_atom-1+lower_index-int_index_old
 589         else
 590           jat_start=first_atom
 591         endif
 592         if (lprn) write (iout,*) 'jat_start',jat_start
 593         if (int_index.ge.upper_index) then
 594           at_end=atom
 595           jat_end=first_atom-1+upper_index-int_index_old
 596           return1
 597         else
 598           jat_end=last_atom
 599         endif
 600         if (lprn) write (iout,*) 'jat_end',jat_end
 601       endif
 602       return
 603       end
 604 c------------------------------------------------------------------------------
 605       subroutine hpb_partition
 606       implicit real*8 (a-h,o-z)
 607       include 'DIMENSIONS'
 608       include 'COMMON.SBRIDGE'
 609       include 'COMMON.IOUNITS'
 610 #ifdef MPL
 611       include 'COMMON.INFO'
 612       call int_bounds(nhpb,link_start,link_end)
 613 #else
 614       link_start=1
 615       link_end=nhpb
 616 #endif
 617 cd    write (iout,*) 'Processor',MyID,' MyRank',MyRank,
 618 cd   &  ' nhpb',nhpb,' link_start=',link_start,
 619 cd   &  ' link_end',link_end
 620       return
 621       end