source/unres/src_MD/old_F/initialize_p.F.safe

   1       block data
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'COMMON.MCM'
   5       include 'COMMON.MD'
   6       data MovTypID
   7      &  /'pool','chain regrow','multi-bond','phi','theta','side chain',
   8      &   'total'/
   9 c Conversion from poises to molecular unit and the gas constant
  10       data cPoise /2.9361d0/, Rb /0.001986d0/
  11       end
  12 c--------------------------------------------------------------------------
  13       subroutine initialize
  14 C
  15 C Define constants and zero out tables.
  16 C
  17       implicit real*8 (a-h,o-z)
  18       include 'DIMENSIONS'
  19 #ifdef MPI
  20       include 'mpif.h'
  21 #endif
  22 #ifndef ISNAN
  23       external proc_proc
  24 #ifdef WINPGI
  25 cMS$ATTRIBUTES C ::  proc_proc
  26 #endif
  27 #endif
  28       include 'COMMON.IOUNITS'
  29       include 'COMMON.CHAIN'
  30       include 'COMMON.INTERACT'
  31       include 'COMMON.GEO'
  32       include 'COMMON.LOCAL'
  33       include 'COMMON.TORSION'
  34       include 'COMMON.FFIELD'
  35       include 'COMMON.SBRIDGE'
  36       include 'COMMON.MCM'
  37       include 'COMMON.MINIM'
  38       include 'COMMON.DERIV'
  39       include 'COMMON.SPLITELE'
  40 c Common blocks from the diagonalization routines
  41       COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
  42       COMMON /MACHSW/ KDIAG,ICORFL,IXDR
  43       logical mask_r
  44 c      real*8 text1 /'initial_i'/
  45
  46       mask_r=.false.
  47 #ifndef ISNAN
  48 c NaNQ initialization
  49       i=-1
  50       rr=dacos(100.0d0)
  51 #ifdef WINPGI
  52       idumm=proc_proc(rr,i)
  53 #else
  54       call proc_proc(rr,i)
  55 #endif
  56 #endif
  57
  58       kdiag=0
  59       icorfl=0
  60       iw=2
  61 C
  62 C The following is just to define auxiliary variables used in angle conversion
  63 C
  64       pi=4.0D0*datan(1.0D0)
  65       dwapi=2.0D0*pi
  66       dwapi3=dwapi/3.0D0
  67       pipol=0.5D0*pi
  68       deg2rad=pi/180.0D0
  69       rad2deg=1.0D0/deg2rad
  70       angmin=10.0D0*deg2rad
  71 C
  72 C Define I/O units.
  73 C
  74       inp=    1
  75       iout=   2
  76       ipdbin= 3
  77       ipdb=   7
  78       icart = 30
  79       imol2=  4
  80       igeom=  8
  81       intin=  9
  82       ithep= 11
  83       irotam=12
  84       itorp= 13
  85       itordp= 23
  86       ielep= 14
  87       isidep=15
  88       iscpp=25
  89       icbase=16
  90       ifourier=20
  91       istat= 17
  92       irest1=55
  93       irest2=56
  94       iifrag=57
  95       ientin=18
  96       ientout=19
  97       ibond = 28
  98       isccor = 29
  99 crc for write_rmsbank1
 100       izs1=21
 101 cdr  include secondary structure prediction bias
 102       isecpred=27
 103 C
 104 C CSA I/O units (separated from others especially for Jooyoung)
 105 C
 106       icsa_rbank=30
 107       icsa_seed=31
 108       icsa_history=32
 109       icsa_bank=33
 110       icsa_bank1=34
 111       icsa_alpha=35
 112       icsa_alpha1=36
 113       icsa_bankt=37
 114       icsa_int=39
 115       icsa_bank_reminimized=38
 116       icsa_native_int=41
 117       icsa_in=40
 118 crc for ifc error 118
 119       icsa_pdb=42
 120 C
 121 C Set default weights of the energy terms.
 122 C
 123       wlong=1.0D0
 124       welec=1.0D0
 125       wtor =1.0D0
 126       wang =1.0D0
 127       wscloc=1.0D0
 128       wstrain=1.0D0
 129 C
 130 C Zero out tables.
 131 C
 132       print '(a,$)','Inside initialize'
 133 c      call memmon_print_usage()
 134       do i=1,maxres2
 135         do j=1,3
 136           c(j,i)=0.0D0
 137           dc(j,i)=0.0D0
 138         enddo
 139       enddo
 140       do i=1,maxres
 141         do j=1,3
 142           xloc(j,i)=0.0D0
 143         enddo
 144       enddo
 145       do i=1,ntyp
 146         do j=1,ntyp
 147           aa(i,j)=0.0D0
 148           bb(i,j)=0.0D0
 149           augm(i,j)=0.0D0
 150           sigma(i,j)=0.0D0
 151           r0(i,j)=0.0D0
 152           chi(i,j)=0.0D0
 153         enddo
 154         do j=1,2
 155           bad(i,j)=0.0D0
 156         enddo
 157         chip(i)=0.0D0
 158         alp(i)=0.0D0
 159         sigma0(i)=0.0D0
 160         sigii(i)=0.0D0
 161         rr0(i)=0.0D0
 162         a0thet(i)=0.0D0
 163         do j=1,2
 164           athet(j,i)=0.0D0
 165           bthet(j,i)=0.0D0
 166         enddo
 167         do j=0,3
 168           polthet(j,i)=0.0D0
 169         enddo
 170         do j=1,3
 171           gthet(j,i)=0.0D0
 172         enddo
 173         theta0(i)=0.0D0
 174         sig0(i)=0.0D0
 175         sigc0(i)=0.0D0
 176         do j=1,maxlob
 177           bsc(j,i)=0.0D0
 178           do k=1,3
 179             censc(k,j,i)=0.0D0
 180           enddo
 181           do k=1,3
 182             do l=1,3
 183               gaussc(l,k,j,i)=0.0D0
 184             enddo
 185           enddo
 186           nlob(i)=0
 187         enddo
 188       enddo
 189       nlob(ntyp1)=0
 190       dsc(ntyp1)=0.0D0
 191       do i=1,maxtor
 192         itortyp(i)=0
 193         do j=1,maxtor
 194           do k=1,maxterm
 195             v1(k,j,i)=0.0D0
 196             v2(k,j,i)=0.0D0
 197           enddo
 198         enddo
 199       enddo
 200       do i=1,maxres
 201         itype(i)=0
 202         itel(i)=0
 203       enddo
 204 C Initialize the bridge arrays
 205       ns=0
 206       nss=0
 207       nhpb=0
 208       do i=1,maxss
 209         iss(i)=0
 210       enddo
 211       do i=1,maxdim
 212         dhpb(i)=0.0D0
 213       enddo
 214       do i=1,maxres
 215         ihpb(i)=0
 216         jhpb(i)=0
 217       enddo
 218 C
 219 C Initialize timing.
 220 C
 221       call set_timers
 222 C
 223 C Initialize variables used in minimization.
 224 C
 225 c     maxfun=5000
 226 c     maxit=2000
 227       maxfun=500
 228       maxit=200
 229       tolf=1.0D-2
 230       rtolf=5.0D-4
 231 C
 232 C Initialize the variables responsible for the mode of gradient storage.
 233 C
 234       nfl=0
 235       icg=1
 236 C
 237 C Initialize constants used to split the energy into long- and short-range
 238 C components
 239 C
 240       r_cut=2.0d0
 241       rlamb=0.3d0
 242 #ifndef SPLITELE
 243       nprint_ene=nprint_ene-1
 244 #endif
 245       return
 246       end
 247 c-------------------------------------------------------------------------
 248       block data nazwy
 249       implicit real*8 (a-h,o-z)
 250       include 'DIMENSIONS'
 251       include 'COMMON.NAMES'
 252       include 'COMMON.FFIELD'
 253       data restyp /
 254      &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
 255      &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
 256       data onelet /
 257      &'C','M','F','I','L','V','W','Y','A','G','T',
 258      &'S','Q','N','E','D','H','R','K','P','X'/
 259       data potname /'LJ','LJK','BP','GB','GBV'/
 260       data ename /
 261      &   "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
 262      &   "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
 263      &   "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
 264      &   "ESTR ","EVDW2_14 ","UCONST ", "      ","ESCCOR"/
 265       data wname /
 266      &   "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
 267      &   "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
 268      &   "WSTRAIN","WVDWPP","WBOND","SCAL14","     ","    ","WSCCOR"/
 269       data nprint_ene /20/
 270       data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
 271      & 21,0/
 272       end
 273 c---------------------------------------------------------------------------
 274       subroutine init_int_table
 275       implicit real*8 (a-h,o-z)
 276       include 'DIMENSIONS'
 277 #ifdef MPI
 278       include 'mpif.h'
 279       integer blocklengths(15),displs(15)
 280 #endif
 281       include 'COMMON.CONTROL'
 282       include 'COMMON.SETUP'
 283       include 'COMMON.CHAIN'
 284       include 'COMMON.INTERACT'
 285       include 'COMMON.LOCAL'
 286       include 'COMMON.SBRIDGE'
 287       include 'COMMON.TORCNSTR'
 288       include 'COMMON.IOUNITS'
 289       logical scheck,lprint
 290 #ifdef MPI
 291       integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
 292      & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
 293 C... Determine the numbers of start and end SC-SC interaction
 294 C... to deal with by current processor.
 295       lprint=.false.
 296       if (lprint)
 297      &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
 298       n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
 299       call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
 300       if (lprint)
 301      &  write (iout,*) 'Processor',fg_rank,' CG group',kolor,
 302      &  ' absolute rank',MyRank,
 303      &  ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
 304      &  ' my_sc_inde',my_sc_inde
 305       ind_sctint=0
 306       iatsc_s=0
 307       iatsc_e=0
 308 #endif
 309 c      lprint=.false.
 310       do i=1,maxres
 311         nint_gr(i)=0
 312         nscp_gr(i)=0
 313         do j=1,maxint_gr
 314           istart(i,1)=0
 315           iend(i,1)=0
 316           ielstart(i)=0
 317           ielend(i)=0
 318           iscpstart(i,1)=0
 319           iscpend(i,1)=0
 320         enddo
 321       enddo
 322       ind_scint=0
 323       ind_scint_old=0
 324 cd    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 325 cd   &   (ihpb(i),jhpb(i),i=1,nss)
 326       do i=nnt,nct-1
 327         scheck=.false.
 328         do ii=1,nss
 329           if (ihpb(ii).eq.i+nres) then
 330             scheck=.true.
 331             jj=jhpb(ii)-nres
 332             goto 10
 333           endif
 334         enddo
 335    10   continue
 336 cd      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 337         if (scheck) then
 338           if (jj.eq.i+1) then
 339 #ifdef MPI
 340             write (iout,*) 'jj=i+1'
 341             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 342      & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 343 #else
 344             nint_gr(i)=1
 345             istart(i,1)=i+2
 346             iend(i,1)=nct
 347 #endif
 348           else if (jj.eq.nct) then
 349 #ifdef MPI
 350             write (iout,*) 'jj=nct'
 351             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 352      &  iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 353 #else
 354             nint_gr(i)=1
 355             istart(i,1)=i+1
 356             iend(i,1)=nct-1
 357 #endif
 358           else
 359 #ifdef MPI
 360             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 361      & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 362             ii=nint_gr(i)+1
 363             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 364      & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
 365 #else
 366             nint_gr(i)=2
 367             istart(i,1)=i+1
 368             iend(i,1)=jj-1
 369             istart(i,2)=jj+1
 370             iend(i,2)=nct
 371 #endif
 372           endif
 373         else
 374 #ifdef MPI
 375           call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
 376      &    iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 377 #else
 378           nint_gr(i)=1
 379           istart(i,1)=i+1
 380           iend(i,1)=nct
 381           ind_scint=ind_scint+nct-i
 382 #endif
 383         endif
 384 #ifdef MPI
 385         ind_scint_old=ind_scint
 386 #endif
 387       enddo
 388    12 continue
 389 #ifndef MPI
 390       iatsc_s=nnt
 391       iatsc_e=nct-1
 392 #endif
 393 #ifdef MPI
 394       if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
 395      &   ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
 396 #endif
 397       if (lprint) then
 398       write (iout,'(a)') 'Interaction array:'
 399       do i=iatsc_s,iatsc_e
 400         write (iout,'(i3,2(2x,2i3))')
 401      & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 402       enddo
 403       endif
 404       ispp=2
 405 #ifdef MPI
 406 C Now partition the electrostatic-interaction array
 407       npept=nct-nnt
 408       nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
 409       call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
 410       if (lprint)
 411      & write (*,*) 'Processor',fg_rank,' CG group',kolor,
 412      &  ' absolute rank',MyRank,
 413      &  ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
 414      &               ' my_ele_inde',my_ele_inde
 415       iatel_s=0
 416       iatel_e=0
 417       ind_eleint=0
 418       ind_eleint_old=0
 419       do i=nnt,nct-3
 420         ijunk=0
 421         call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
 422      &    iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
 423       enddo ! i
 424    13 continue
 425 #else
 426       iatel_s=nnt
 427       iatel_e=nct-3
 428       do i=iatel_s,iatel_e
 429         ielstart(i)=i+2
 430         ielend(i)=nct-1
 431       enddo
 432 #endif
 433       if (lprint) then
 434         write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
 435      &  ' absolute rank',MyRank
 436         write (iout,*) 'Electrostatic interaction array:'
 437         do i=iatel_s,iatel_e
 438           write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
 439         enddo
 440       endif ! lprint
 441 c     iscp=3
 442       iscp=2
 443 C Partition the SC-p interaction array
 444 #ifdef MPI
 445       nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
 446       call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
 447       if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
 448      &  ' absolute rank',myrank,
 449      &  ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
 450      &               ' my_scp_inde',my_scp_inde
 451       iatscp_s=0
 452       iatscp_e=0
 453       ind_scpint=0
 454       ind_scpint_old=0
 455       do i=nnt,nct-1
 456         if (i.lt.nnt+iscp) then
 457 cd        write (iout,*) 'i.le.nnt+iscp'
 458           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 459      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
 460      &      iscpend(i,1),*14)
 461         else if (i.gt.nct-iscp) then
 462 cd        write (iout,*) 'i.gt.nct-iscp'
 463           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 464      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 465      &      iscpend(i,1),*14)
 466         else
 467           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 468      &      iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
 469      &      iscpend(i,1),*14)
 470           ii=nscp_gr(i)+1
 471           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
 472      &      iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
 473      &      iscpend(i,ii),*14)
 474         endif
 475       enddo ! i
 476    14 continue
 477 #else
 478       iatscp_s=nnt
 479       iatscp_e=nct-1
 480       do i=nnt,nct-1
 481         if (i.lt.nnt+iscp) then
 482           nscp_gr(i)=1
 483           iscpstart(i,1)=i+iscp
 484           iscpend(i,1)=nct
 485         elseif (i.gt.nct-iscp) then
 486           nscp_gr(i)=1
 487           iscpstart(i,1)=nnt
 488           iscpend(i,1)=i-iscp
 489         else
 490           nscp_gr(i)=2
 491           iscpstart(i,1)=nnt
 492           iscpend(i,1)=i-iscp
 493           iscpstart(i,2)=i+iscp
 494           iscpend(i,2)=nct
 495         endif
 496       enddo ! i
 497 #endif
 498       if (lprint) then
 499         write (iout,'(a)') 'SC-p interaction array:'
 500         do i=iatscp_s,iatscp_e
 501           write (iout,'(i3,2(2x,2i3))')
 502      &         i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 503         enddo
 504       endif ! lprint
 505 C Partition local interactions
 506 #ifdef MPI
 507       call int_bounds(nres-2,loc_start,loc_end)
 508       loc_start=loc_start+1
 509       loc_end=loc_end+1
 510       call int_bounds(nres-2,ithet_start,ithet_end)
 511       ithet_start=ithet_start+2
 512       ithet_end=ithet_end+2
 513       call int_bounds(nct-nnt-2,iphi_start,iphi_end)
 514       iphi_start=iphi_start+nnt+2
 515       iphi_end=iphi_end+nnt+2
 516       call int_bounds(nct-nnt-3,iphid_start,iphid_end)
 517       iphid_start=iphid_start+nnt+2
 518       iphid_end=iphid_end+nnt+2
 519       call int_bounds(nres-2,ibond_start,ibond_end)
 520       ibond_start=ibond_start+1
 521       ibond_end=ibond_end+1
 522       call int_bounds(nct-nnt,ibondp_start,ibondp_end)
 523       ibondp_start=ibondp_start+nnt
 524       ibondp_end=ibondp_end+nnt
 525       call int_bounds(nres-1,ivec_start,ivec_end)
 526       iset_start=loc_start+2
 527       iset_end=loc_end+2
 528       if (ndih_constr.eq.0) then
 529         idihconstr_start=1
 530         idihconstr_end=0
 531       else
 532         call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
 533       endif
 534       lprint=.true.
 535       if (lprint) then
 536         write (*,*) 'Processor:',fg_rank,' CG group',kolor,
 537      & ' absolute rank',myrank,
 538      & ' loc_start',loc_start,' loc_end',loc_end,
 539      & ' ithet_start',ithet_start,' ithet_end',ithet_end,
 540      & ' iphi_start',iphi_start,' iphi_end',iphi_end,
 541      & ' iphid_start',iphid_start,' iphid_end',iphid_end,
 542      & ' ibond_start',ibond_start,' ibond_end',ibond_end,
 543      & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
 544      & ' ivec_start',ivec_start,' ivec_end',ivec_end,
 545      & ' iset_start',iset_start,' iset_end',iset_end,
 546      & ' idihconstr_start',idihconstr_start,' idihconstr_end',
 547      &   idihconstr_end
 548       endif
 549       if (nfgtasks.gt.1) then
 550         call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
 551      &    MPI_INTEGER,FG_COMM,IERROR)
 552         iaux=ivec_end-ivec_start+1
 553         call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
 554      &    MPI_INTEGER,FG_COMM,IERROR)
 555         call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
 556      &    MPI_INTEGER,FG_COMM,IERROR)
 557         iaux=iset_end-iset_start+1
 558         call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
 559      &    MPI_INTEGER,FG_COMM,IERROR)
 560         call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
 561         call MPI_Type_commit(MPI_UYZ,IERROR)
 562         call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
 563      &    IERROR)
 564         call MPI_Type_commit(MPI_UYZGRAD,IERROR)
 565         call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
 566         call MPI_Type_commit(MPI_MU,IERROR)
 567         call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
 568         call MPI_Type_commit(MPI_MAT1,IERROR)
 569         call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
 570         call MPI_Type_commit(MPI_MAT2,IERROR)
 571 #ifndef MATGATHER
 572 c 9/22/08 Derived types to send matrices which appear in correlation terms
 573         do i=0,nfgtasks-1
 574           if (ivec_count(i).eq.ivec_count(0)) then
 575             lentyp(i)=0
 576           else
 577             lentyp(i)=1
 578           endif
 579         enddo
 580         do ind_typ=lentyp(0),lentyp(nfgtasks-1)
 581         if (ind_typ.eq.0) then
 582           ichunk=ivec_count(0)
 583         else
 584           ichunk=ivec_count(1)
 585         endif
 586 c        do i=1,4
 587 c          blocklengths(i)=4
 588 c        enddo
 589 c        displs(1)=0
 590 c        do i=2,4
 591 c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 592 c        enddo
 593 c        do i=1,4
 594 c          blocklengths(i)=blocklengths(i)*ichunk
 595 c        enddo
 596 c        write (iout,*) "blocklengths and displs"
 597 c        do i=1,4
 598 c          write (iout,*) i,blocklengths(i),displs(i)
 599 c        enddo
 600 c        call flush(iout)
 601 c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
 602 c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
 603 c        call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
 604 c        write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
 605 c        do i=1,4
 606 c          blocklengths(i)=2
 607 c        enddo
 608 c        displs(1)=0
 609 c        do i=2,4
 610 c          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 611 c        enddo
 612 c        do i=1,4
 613 c          blocklengths(i)=blocklengths(i)*ichunk
 614 c        enddo
 615 c        write (iout,*) "blocklengths and displs"
 616 c        do i=1,4
 617 c          write (iout,*) i,blocklengths(i),displs(i)
 618 c        enddo
 619 c        call flush(iout)
 620 c        call MPI_Type_indexed(4,blocklengths(1),displs(1),
 621 c     &    MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
 622 c        call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
 623 c        write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
 624         do i=1,8
 625           blocklengths(i)=2
 626         enddo
 627         displs(1)=0
 628         do i=2,8
 629           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 630         enddo
 631         do i=1,15
 632           blocklengths(i)=blocklengths(i)*ichunk
 633         enddo
 634         call MPI_Type_indexed(8,blocklengths,displs,
 635      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
 636         call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
 637         do i=1,8
 638           blocklengths(i)=4
 639         enddo
 640         displs(1)=0
 641         do i=2,8
 642           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 643         enddo
 644         do i=1,15
 645           blocklengths(i)=blocklengths(i)*ichunk
 646         enddo
 647         call MPI_Type_indexed(8,blocklengths,displs,
 648      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
 649         call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
 650         do i=1,6
 651           blocklengths(i)=4
 652         enddo
 653         displs(1)=0
 654         do i=2,6
 655           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 656         enddo
 657         do i=1,6
 658           blocklengths(i)=blocklengths(i)*ichunk
 659         enddo
 660         call MPI_Type_indexed(6,blocklengths,displs,
 661      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
 662         call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
 663         do i=1,2
 664           blocklengths(i)=8
 665         enddo
 666         displs(1)=0
 667         do i=2,2
 668           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 669         enddo
 670         do i=1,2
 671           blocklengths(i)=blocklengths(i)*ichunk
 672         enddo
 673         call MPI_Type_indexed(2,blocklengths,displs,
 674      &    MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
 675         call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
 676         do i=1,4
 677           blocklengths(i)=1
 678         enddo
 679         displs(1)=0
 680         do i=2,4
 681           displs(i)=displs(i-1)+blocklengths(i-1)*maxres
 682         enddo
 683         do i=1,4
 684           blocklengths(i)=blocklengths(i)*ichunk
 685         enddo
 686         call MPI_Type_indexed(4,blocklengths,displs,
 687      &    MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
 688         call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
 689         enddo
 690 #endif
 691       endif
 692       do i=0,nfgtasks-1
 693           ivec_displ(i)=ivec_displ(i)-1
 694           iset_displ(i)=iset_displ(i)-1
 695       enddo
 696       if (nfgtasks.gt.1 .and. fg_rank.eq.king
 697      &     .and. (me.eq.0 .or. out1file)) then
 698         write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
 699         do i=0,nfgtasks-1
 700           write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
 701      &      iset_count(i)
 702         enddo
 703         write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
 704      & nele_int_tot,' electrostatic and ',nscp_int_tot,
 705      & ' SC-p interactions','were distributed among',nfgtasks,
 706      & ' fine-grain processors.'
 707       endif
 708 #else
 709       loc_start=2
 710       loc_end=nres-1
 711       ithet_start=3
 712       ithet_end=nres
 713       iphi_start=nnt+3
 714       iphi_end=nct
 715       idihconstr_start=1
 716       idihconstr_end=ndih_constr
 717       iphid_start=iphi_start
 718       iphid_end=iphi_end-1
 719       ibond_start=2
 720       ibond_end=nres-1
 721       ibondp_start=nnt
 722       ibondp_end=nct-1
 723       ivec_start=1
 724       ivec_end=nres-1
 725       iset_start=3
 726       iset_end=nres+1
 727 #endif
 728       return
 729       end
 730 #ifdef MPI
 731 c---------------------------------------------------------------------------
 732       subroutine int_bounds(total_ints,lower_bound,upper_bound)
 733       implicit real*8 (a-h,o-z)
 734       include 'DIMENSIONS'
 735       include 'mpif.h'
 736       include 'COMMON.SETUP'
 737       integer total_ints,lower_bound,upper_bound
 738       integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
 739       nint=total_ints/nfgtasks
 740       do i=1,nfgtasks
 741         int4proc(i-1)=nint
 742       enddo
 743       nexcess=total_ints-nint*nfgtasks
 744       do i=1,nexcess
 745         int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
 746       enddo
 747       lower_bound=0
 748       do i=0,fg_rank-1
 749         lower_bound=lower_bound+int4proc(i)
 750       enddo
 751       upper_bound=lower_bound+int4proc(fg_rank)
 752       lower_bound=lower_bound+1
 753       return
 754       end
 755 c---------------------------------------------------------------------------
 756       subroutine int_partition(int_index,lower_index,upper_index,atom,
 757      & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
 758       implicit real*8 (a-h,o-z)
 759       include 'DIMENSIONS'
 760       include 'COMMON.IOUNITS'
 761       integer int_index,lower_index,upper_index,atom,at_start,at_end,
 762      & first_atom,last_atom,int_gr,jat_start,jat_end
 763       logical lprn
 764       lprn=.false.
 765       if (lprn) write (iout,*) 'int_index=',int_index
 766       int_index_old=int_index
 767       int_index=int_index+last_atom-first_atom+1
 768       if (lprn)
 769      &   write (iout,*) 'int_index=',int_index,
 770      &               ' int_index_old',int_index_old,
 771      &               ' lower_index=',lower_index,
 772      &               ' upper_index=',upper_index,
 773      &               ' atom=',atom,' first_atom=',first_atom,
 774      &               ' last_atom=',last_atom
 775       if (int_index.ge.lower_index) then
 776         int_gr=int_gr+1
 777         if (at_start.eq.0) then
 778           at_start=atom
 779           jat_start=first_atom-1+lower_index-int_index_old
 780         else
 781           jat_start=first_atom
 782         endif
 783         if (lprn) write (iout,*) 'jat_start',jat_start
 784         if (int_index.ge.upper_index) then
 785           at_end=atom
 786           jat_end=first_atom-1+upper_index-int_index_old
 787           return1
 788         else
 789           jat_end=last_atom
 790         endif
 791         if (lprn) write (iout,*) 'jat_end',jat_end
 792       endif
 793       return
 794       end
 795 #endif
 796 c------------------------------------------------------------------------------
 797       subroutine hpb_partition
 798       implicit real*8 (a-h,o-z)
 799       include 'DIMENSIONS'
 800 #ifdef MPI
 801       include 'mpif.h'
 802 #endif
 803       include 'COMMON.SBRIDGE'
 804       include 'COMMON.IOUNITS'
 805       include 'COMMON.SETUP'
 806 #ifdef MPI
 807       call int_bounds(nhpb,link_start,link_end)
 808 cd    write (*,*) 'Processor',fg_rank,' CG group',color,
 809 cd      ' absolute rank',MyRank,
 810 cd   &  ' nhpb',nhpb,' link_start=',link_start,
 811 cd   &  ' link_end',link_end
 812 #else
 813       link_start=1
 814       link_end=nhpb
 815 #endif
 816       return
 817       end