source/unres/control.f90

   1       module control
   2 !-----------------------------------------------------------------------------
   3       use io_units
   4       use names
   5       use MPI_data
   6       use geometry_data
   7       use energy_data
   8       use control_data
   9       use minim_data
  10       use csa_data
  11       use geometry, only:int_bounds
  12 #ifdef WHAM_RUN
  13       use wham_data
  14 #endif
  15       implicit none
  16 !-----------------------------------------------------------------------------
  17 ! common.time1
  18 !     FOUND_NAN - set by calcf to stop sumsl via stopx
  19 !      COMMON/TIME1/
  20       real(kind=8) :: STIME,BATIME,PREVTIM,RSTIME
  21 !el      real(kind=8) :: TIMLIM,SAFETY
  22 !el      real(kind=8) :: WALLTIME
  23 !      COMMON/STOPTIM/
  24       integer :: ISTOP
  25 !      common /sumsl_flag/
  26       logical :: FOUND_NAN
  27 !      common /timing/
  28       real(kind=8) :: t_init
  29 !-----------------------------------------------------------------------------
  30 ! initialize_p.F
  31 !-----------------------------------------------------------------------------
  32 !      block data
  33 !      integer,parameter :: MaxMoveType = 4
  34 !      character(len=14),dimension(-1:MaxMoveType+1) :: MovTypID=(/'pool','chain regrow',&
  35 !      character :: MovTypID(-1:MaxMoveType+1)=(/'pool','chain regrow',&
  36 !       'multi-bond','phi','theta','side chain','total'/)
  37 ! Conversion from poises to molecular unit and the gas constant
  38 !el      real(kind=8) :: cPoise=2.9361d0, Rb=0.001986d0
  39 !-----------------------------------------------------------------------------
  40 !      common /przechowalnia/ subroutines: init_int_table,add_int,add_int_from
  41       integer,dimension(:),allocatable :: iturn3_start_all,iturn3_end_all,&
  42         iturn4_start_all,iturn4_end_all,iatel_s_all,iatel_e_all !(0:max_fg_procs)
  43       integer,dimension(:,:),allocatable :: ielstart_all,&
  44         ielend_all !(maxres,0:max_fg_procs-1)
  45
  46 !      common /przechowalnia/ subroutine: init_int_table
  47       integer,dimension(:),allocatable :: ntask_cont_from_all,&
  48         ntask_cont_to_all !(0:max_fg_procs-1)
  49       integer,dimension(:,:),allocatable :: itask_cont_from_all,&
  50         itask_cont_to_all !(0:max_fg_procs-1,0:max_fg_procs-1)
  51 !-----------------------------------------------------------------------------
  52 !
  53 !
  54 !-----------------------------------------------------------------------------
  55       contains
  56 !-----------------------------------------------------------------------------
  57 ! initialize_p.F
  58 !-----------------------------------------------------------------------------
  59       subroutine initialize
  60 !
  61 ! Define constants and zero out tables.
  62 !
  63       use comm_iofile
  64       use comm_machsw
  65       use MCM_data, only: MovTypID
  66 !      implicit real*8 (a-h,o-z)
  67 !      include 'DIMENSIONS'
  68 #ifdef MPI
  69       include 'mpif.h'
  70 #endif
  71 #ifndef ISNAN
  72       external proc_proc
  73 #ifdef WINPGI
  74 !MS$ATTRIBUTES C ::  proc_proc
  75 #endif
  76 #endif
  77 !      include 'COMMON.IOUNITS'
  78 !      include 'COMMON.CHAIN'
  79 !      include 'COMMON.INTERACT'
  80 !      include 'COMMON.GEO'
  81 !      include 'COMMON.LOCAL'
  82 !      include 'COMMON.TORSION'
  83 !      include 'COMMON.FFIELD'
  84 !      include 'COMMON.SBRIDGE'
  85 !      include 'COMMON.MCM'
  86 !      include 'COMMON.MINIM'
  87 !      include 'COMMON.DERIV'
  88 !      include 'COMMON.SPLITELE'
  89 !      implicit none
  90 ! Common blocks from the diagonalization routines
  91 !el      integer :: IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
  92 !el      integer :: KDIAG,ICORFL,IXDR
  93 !el      COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA
  94 !el      COMMON /MACHSW/ KDIAG,ICORFL,IXDR
  95       logical :: mask_r
  96 !      real*8 text1 /'initial_i'/
  97       real(kind=4) :: rr
  98
  99 !local variables el
 100       integer :: i,j,k,l,ichir1,ichir2,iblock,m,maxit
 101
 102 #ifndef WHAM_RUN
 103       mask_r=.false.
 104 #ifndef ISNAN
 105 ! NaNQ initialization
 106       i=-1
 107       rr=dacos(100.0d0)
 108 #ifdef WINPGI
 109       idumm=proc_proc(rr,i)
 110 #else
 111       call proc_proc(rr,i)
 112 #endif
 113 #endif
 114
 115       kdiag=0
 116       icorfl=0
 117       iw=2
 118
 119       allocate(MovTypID(-1:MaxMoveType+1))
 120       MovTypID=(/'pool          ','chain regrow  ',&
 121        'multi-bond    ','phi           ','theta         ',&
 122        'side chain    ','total         '/)
 123 #endif
 124 !
 125 ! The following is just to define auxiliary variables used in angle conversion
 126 !
 127       pi=4.0D0*datan(1.0D0)
 128       dwapi=2.0D0*pi
 129       dwapi3=dwapi/3.0D0
 130       pipol=0.5D0*pi
 131       deg2rad=pi/180.0D0
 132       rad2deg=1.0D0/deg2rad
 133       angmin=10.0D0*deg2rad
 134 !
 135 ! Define I/O units.
 136 !
 137       inp=    1
 138       iout=   2
 139       ipdbin= 3
 140       ipdb=   7
 141       icart = 30
 142       imol2=  4
 143       igeom=  8
 144       intin=  9
 145       ithep= 11
 146       ithep_pdb=51
 147       irotam=12
 148       irotam_pdb=52
 149       itorp= 13
 150       itordp= 23
 151       ielep= 14
 152       isidep=15
 153 #ifdef WHAM_RUN
 154       isidep1=22 !wham
 155 #endif
 156       iscpp=25
 157       icbase=16
 158       ifourier=20
 159       istat= 17
 160       irest1=55
 161       irest2=56
 162       iifrag=57
 163       ientin=18
 164       ientout=19
 165       ibond = 28
 166       isccor = 29
 167 !rc for write_rmsbank1
 168       izs1=21
 169 !dr  include secondary structure prediction bias
 170       isecpred=27
 171 #ifdef WHAM_RUN
 172 !
 173 ! WHAM files
 174 !
 175       ihist=30
 176       iweight=31
 177       izsc=32
 178 !
 179 ! setting the mpi variables for WHAM
 180 !
 181       fgprocs=1
 182       nfgtasks=1
 183       nfgtasks1=1
 184 #endif
 185 !
 186 ! CSA I/O units (separated from others especially for Jooyoung)
 187 !
 188       icsa_rbank=30
 189       icsa_seed=31
 190       icsa_history=32
 191       icsa_bank=33
 192       icsa_bank1=34
 193       icsa_alpha=35
 194       icsa_alpha1=36
 195       icsa_bankt=37
 196       icsa_int=39
 197       icsa_bank_reminimized=38
 198       icsa_native_int=41
 199       icsa_in=40
 200 !rc for ifc error 118
 201       icsa_pdb=42
 202 !
 203 ! Set default weights of the energy terms.
 204 !
 205       wsc=1.0D0 ! in wham:  wlong=1.0D0
 206       welec=1.0D0
 207       wtor =1.0D0
 208       wang =1.0D0
 209       wscloc=1.0D0
 210       wstrain=1.0D0
 211 !
 212 ! Zero out tables.
 213 !
 214 !      print '(a,$)','Inside initialize'
 215 !      call memmon_print_usage()
 216
 217 !      do i=1,maxres2
 218 !       do j=1,3
 219 !         c(j,i)=0.0D0
 220 !         dc(j,i)=0.0D0
 221 !       enddo
 222 !      enddo
 223 !      do i=1,maxres
 224 !       do j=1,3
 225 !         xloc(j,i)=0.0D0
 226 !        enddo
 227 !      enddo
 228 !      do i=1,ntyp
 229 !       do j=1,ntyp
 230 !         aa(i,j)=0.0D0
 231 !         bb(i,j)=0.0D0
 232 !         augm(i,j)=0.0D0
 233 !         sigma(i,j)=0.0D0
 234 !         r0(i,j)=0.0D0
 235 !         chi(i,j)=0.0D0
 236 !        enddo
 237 !       do j=1,2
 238 !         bad(i,j)=0.0D0
 239 !        enddo
 240 !       chip(i)=0.0D0
 241 !       alp(i)=0.0D0
 242 !       sigma0(i)=0.0D0
 243 !       sigii(i)=0.0D0
 244 !       rr0(i)=0.0D0
 245 !       a0thet(i)=0.0D0
 246 !       do j=1,2
 247 !         do ichir1=-1,1
 248 !          do ichir2=-1,1
 249 !          athet(j,i,ichir1,ichir2)=0.0D0
 250 !          bthet(j,i,ichir1,ichir2)=0.0D0
 251 !          enddo
 252 !         enddo
 253 !        enddo
 254 !        do j=0,3
 255 !         polthet(j,i)=0.0D0
 256 !        enddo
 257 !       do j=1,3
 258 !         gthet(j,i)=0.0D0
 259 !        enddo
 260 !       theta0(i)=0.0D0
 261 !       sig0(i)=0.0D0
 262 !       sigc0(i)=0.0D0
 263 !       do j=1,maxlob
 264 !         bsc(j,i)=0.0D0
 265 !         do k=1,3
 266 !           censc(k,j,i)=0.0D0
 267 !          enddo
 268 !          do k=1,3
 269 !           do l=1,3
 270 !             gaussc(l,k,j,i)=0.0D0
 271 !            enddo
 272 !          enddo
 273 !         nlob(i)=0
 274 !        enddo
 275 !      enddo
 276 !      nlob(ntyp1)=0
 277 !      dsc(ntyp1)=0.0D0
 278 !      do i=-maxtor,maxtor
 279 !        itortyp(i)=0
 280 !c      write (iout,*) "TU DOCHODZE",i,itortyp(i)
 281 !       do iblock=1,2
 282 !        do j=-maxtor,maxtor
 283 !          do k=1,maxterm
 284 !            v1(k,j,i,iblock)=0.0D0
 285 !            v2(k,j,i,iblock)=0.0D0
 286 !          enddo
 287 !        enddo
 288 !        enddo
 289 !      enddo
 290 !      do iblock=1,2
 291 !       do i=-maxtor,maxtor
 292 !        do j=-maxtor,maxtor
 293 !         do k=-maxtor,maxtor
 294 !          do l=1,maxtermd_1
 295 !            v1c(1,l,i,j,k,iblock)=0.0D0
 296 !            v1s(1,l,i,j,k,iblock)=0.0D0
 297 !            v1c(2,l,i,j,k,iblock)=0.0D0
 298 !            v1s(2,l,i,j,k,iblock)=0.0D0
 299 !          enddo !l
 300 !          do l=1,maxtermd_2
 301 !           do m=1,maxtermd_2
 302 !            v2c(m,l,i,j,k,iblock)=0.0D0
 303 !            v2s(m,l,i,j,k,iblock)=0.0D0
 304 !           enddo !m
 305 !          enddo !l
 306 !        enddo !k
 307 !       enddo !j
 308 !      enddo !i
 309 !      enddo !iblock
 310
 311 !      do i=1,maxres
 312 !       itype(i)=0
 313 !       itel(i)=0
 314 !      enddo
 315 ! Initialize the bridge arrays
 316       ns=0
 317       nss=0
 318       nhpb=0
 319 !      do i=1,maxss
 320 !       iss(i)=0
 321 !      enddo
 322 !      do i=1,maxdim
 323 !       dhpb(i)=0.0D0
 324 !      enddo
 325 !      do i=1,maxres
 326 !       ihpb(i)=0
 327 !       jhpb(i)=0
 328 !      enddo
 329 !
 330 ! Initialize timing.
 331 !
 332       call set_timers
 333 !
 334 ! Initialize variables used in minimization.
 335 !
 336 !c     maxfun=5000
 337 !c     maxit=2000
 338       maxfun=500
 339       maxit=200
 340       tolf=1.0D-2
 341       rtolf=5.0D-4
 342 !
 343 ! Initialize the variables responsible for the mode of gradient storage.
 344 !
 345       nfl=0
 346       icg=1
 347
 348 !el      if (run_wham) then !el
 349 #ifdef WHAM_RUN
 350       ndih_constr=0
 351
 352 !      allocate(ww0(max_eneW))
 353 !      ww0 = reshape((/1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,&
 354 !          1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,&
 355 !          1.0d0,0.0d0,0.0/), shape(ww0))
 356 !
 357 !      allocate(iww(max_eneW))
 358       do i=1,14
 359         do j=1,14
 360           if (print_order(i).eq.j) then
 361             iww(print_order(i))=j
 362             goto 1121
 363           endif
 364         enddo
 365 1121    continue
 366       enddo
 367       calc_grad=.false.
 368 ! Set timers and counters for the respective routines
 369       t_func = 0.0d0
 370       t_grad = 0.0d0
 371       t_fhel = 0.0d0
 372       t_fbet = 0.0d0
 373       t_ghel = 0.0d0
 374       t_gbet = 0.0d0
 375       t_viol = 0.0d0
 376       t_gviol = 0.0d0
 377       n_func = 0
 378       n_grad = 0
 379       n_fhel = 0
 380       n_fbet = 0
 381       n_ghel = 0
 382       n_gbet = 0
 383       n_viol = 0
 384       n_gviol = 0
 385       n_map = 0
 386 #endif
 387 !
 388 ! Initialize constants used to split the energy into long- and short-range
 389 ! components
 390 !
 391       r_cut=2.0d0
 392       rlamb=0.3d0
 393 #ifndef SPLITELE
 394       nprint_ene=nprint_ene-1
 395 #endif
 396       return
 397       end subroutine initialize
 398 !-----------------------------------------------------------------------------
 399       subroutine init_int_table
 400
 401       use geometry, only:int_bounds1
 402 !el      implicit none
 403 !      implicit real*8 (a-h,o-z)
 404 !      include 'DIMENSIONS'
 405 #ifdef MPI
 406       include 'mpif.h'
 407       integer,dimension(15) :: blocklengths,displs
 408 #endif
 409 !      include 'COMMON.CONTROL'
 410 !      include 'COMMON.SETUP'
 411 !      include 'COMMON.CHAIN'
 412 !      include 'COMMON.INTERACT'
 413 !      include 'COMMON.LOCAL'
 414 !      include 'COMMON.SBRIDGE'
 415 !      include 'COMMON.TORCNSTR'
 416 !      include 'COMMON.IOUNITS'
 417 !      include 'COMMON.DERIV'
 418 !      include 'COMMON.CONTACTS'
 419 !el      integer,dimension(0:nfgtasks) :: iturn3_start_all,iturn3_end_all,&
 420 !el        iturn4_start_all,iturn4_end_all,iatel_s_all,iatel_e_all  !(0:max_fg_procs)
 421 !el      integer,dimension(nres,0:nfgtasks) :: ielstart_all,&
 422 !el        ielend_all !(maxres,0:max_fg_procs-1)
 423 !el      integer,dimension(0:nfgtasks-1) :: ntask_cont_from_all,&
 424 !el        ntask_cont_to_all !(0:max_fg_procs-1),
 425 !el      integer,dimension(0:nfgtasks-1,0:nfgtasks-1) :: itask_cont_from_all,&
 426 !el        itask_cont_to_all !(0:max_fg_procs-1,0:max_fg_procs-1)
 427
 428 !el      common /przechowalnia/ iturn3_start_all,iturn3_end_all,&
 429 !el        iturn4_start_all,iturn4_end_all,iatel_s_all,iatel_e_all,&
 430 !el        ielstart_all,ielend_all,ntask_cont_from_all,itask_cont_from_all,&
 431 !el        ntask_cont_to_all,itask_cont_to_all
 432
 433       integer :: FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
 434       logical :: scheck,lprint,flag
 435
 436 !el local variables
 437       integer :: ind_scint=0,ind_scint_old,ii,jj,i,j,iint
 438
 439 #ifdef MPI
 440       integer :: my_sc_int(0:nfgtasks-1),my_ele_int(0:nfgtasks-1)
 441       integer :: my_sc_intt(0:nfgtasks),my_ele_intt(0:nfgtasks)
 442       integer :: n_sc_int_tot,my_sc_inde,my_sc_inds,ind_sctint,npept
 443       integer :: nele_int_tot,my_ele_inds,my_ele_inde,ind_eleint_old,&
 444             ind_eleint,ijunk,nele_int_tot_vdw,my_ele_inds_vdw,&
 445             my_ele_inde_vdw,ind_eleint_vdw,ind_eleint_vdw_old,&
 446             nscp_int_tot,my_scp_inds,my_scp_inde,ind_scpint,&
 447             ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,&
 448             ierror,k,ierr,iaux,ncheck_to,ncheck_from,ind_typ,&
 449             ichunk,int_index_old
 450
 451 !el      allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
 452 !el      allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
 453
 454 !... Determine the numbers of start and end SC-SC interaction
 455 !... to deal with by current processor.
 456       do i=0,nfgtasks-1
 457         itask_cont_from(i)=fg_rank
 458         itask_cont_to(i)=fg_rank
 459       enddo
 460       lprint=energy_dec
 461       if (lprint) &
 462        write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
 463       n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
 464       call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
 465 write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
 466       if (lprint) &
 467         write (iout,*) 'Processor',fg_rank,' CG group',kolor,&
 468         ' absolute rank',MyRank,&
 469         ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,&
 470         ' my_sc_inde',my_sc_inde
 471       ind_sctint=0
 472       iatsc_s=0
 473       iatsc_e=0
 474 #endif
 475 !el       common /przechowalnia/
 476       allocate(iturn3_start_all(0:nfgtasks))
 477       allocate(iturn3_end_all(0:nfgtasks))
 478       allocate(iturn4_start_all(0:nfgtasks))
 479       allocate(iturn4_end_all(0:nfgtasks))
 480       allocate(iatel_s_all(0:nfgtasks))
 481       allocate(iatel_e_all(0:nfgtasks))
 482       allocate(ielstart_all(nres,0:nfgtasks-1))
 483       allocate(ielend_all(nres,0:nfgtasks-1))
 484
 485       allocate(ntask_cont_from_all(0:nfgtasks-1))
 486       allocate(ntask_cont_to_all(0:nfgtasks-1))
 487       allocate(itask_cont_from_all(0:nfgtasks-1,0:nfgtasks-1))
 488       allocate(itask_cont_to_all(0:nfgtasks-1,0:nfgtasks-1))
 489 !el----------
 490 !      lprint=.false.
 491       do i=1,nres !el   !maxres
 492         nint_gr(i)=0
 493         nscp_gr(i)=0
 494         ielstart(i)=0
 495         ielend(i)=0
 496         do j=1,maxint_gr
 497           istart(i,j)=0
 498           iend(i,j)=0
 499           iscpstart(i,j)=0
 500           iscpend(i,j)=0
 501         enddo
 502       enddo
 503       ind_scint=0
 504       ind_scint_old=0
 505 !d    write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
 506 !d   &   (ihpb(i),jhpb(i),i=1,nss)
 507       do i=nnt,nct-1
 508         scheck=.false.
 509         if (dyn_ss) goto 10
 510         do ii=1,nss
 511           if (ihpb(ii).eq.i+nres) then
 512             scheck=.true.
 513             jj=jhpb(ii)-nres
 514             goto 10
 515           endif
 516         enddo
 517    10   continue
 518 !d      write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
 519         if (scheck) then
 520           if (jj.eq.i+1) then
 521 #ifdef MPI
 522 !            write (iout,*) 'jj=i+1'
 523             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
 524        iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 525 #else
 526             nint_gr(i)=1
 527             istart(i,1)=i+2
 528             iend(i,1)=nct
 529 #endif
 530           else if (jj.eq.nct) then
 531 #ifdef MPI
 532 !            write (iout,*) 'jj=nct'
 533             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
 534         iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 535 #else
 536             nint_gr(i)=1
 537             istart(i,1)=i+1
 538             iend(i,1)=nct-1
 539 #endif
 540           else
 541 #ifdef MPI
 542             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
 543        iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
 544             ii=nint_gr(i)+1
 545             call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
 546        iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
 547 #else
 548             nint_gr(i)=2
 549             istart(i,1)=i+1
 550             iend(i,1)=jj-1
 551             istart(i,2)=jj+1
 552             iend(i,2)=nct
 553 #endif
 554           endif
 555         else
 556 #ifdef MPI
 557           call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,&
 558           iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
 559 #else
 560           nint_gr(i)=1
 561           istart(i,1)=i+1
 562           iend(i,1)=nct
 563           ind_scint=ind_scint+nct-i
 564 #endif
 565         endif
 566 #ifdef MPI
 567         ind_scint_old=ind_scint
 568 #endif
 569       enddo
 570    12 continue
 571 #ifndef MPI
 572       iatsc_s=nnt
 573       iatsc_e=nct-1
 574 #endif
 575       if (iatsc_s.eq.0) iatsc_s=1
 576 #ifdef MPI
 577       if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,&
 578          ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
 579 #endif
 580       if (lprint) then
 581       write (iout,'(a)') 'Interaction array:'
 582       do i=iatsc_s,iatsc_e
 583         write (iout,'(i3,2(2x,2i3))') &
 584        i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
 585       enddo
 586       endif
 587       ispp=4 !?? wham ispp=2
 588 #ifdef MPI
 589 ! Now partition the electrostatic-interaction array
 590       npept=nct-nnt
 591       nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
 592       call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
 593       if (lprint) &
 594        write (*,*) 'Processor',fg_rank,' CG group',kolor,&
 595         ' absolute rank',MyRank,&
 596         ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,&
 597                     ' my_ele_inde',my_ele_inde
 598       iatel_s=0
 599       iatel_e=0
 600       ind_eleint=0
 601       ind_eleint_old=0
 602       do i=nnt,nct-3
 603         ijunk=0
 604         call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,&
 605           iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
 606       enddo ! i
 607    13 continue
 608       if (iatel_s.eq.0) iatel_s=1
 609       nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
 610 !      write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
 611       call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
 612 !      write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
 613 !     & " my_ele_inde_vdw",my_ele_inde_vdw
 614       ind_eleint_vdw=0
 615       ind_eleint_vdw_old=0
 616       iatel_s_vdw=0
 617       iatel_e_vdw=0
 618       do i=nnt,nct-3
 619         ijunk=0
 620         call int_partition(ind_eleint_vdw,my_ele_inds_vdw,&
 621           my_ele_inde_vdw,i,&
 622           iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),&
 623           ielend_vdw(i),*15)
 624 !        write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
 625 !     &   " ielend_vdw",ielend_vdw(i)
 626       enddo ! i
 627       if (iatel_s_vdw.eq.0) iatel_s_vdw=1
 628    15 continue
 629 #else
 630       iatel_s=nnt
 631       iatel_e=nct-5 ! ?? wham iatel_e=nct-3
 632       do i=iatel_s,iatel_e
 633         ielstart(i)=i+4 ! ?? wham +2
 634         ielend(i)=nct-1
 635       enddo
 636       iatel_s_vdw=nnt
 637       iatel_e_vdw=nct-3
 638       do i=iatel_s_vdw,iatel_e_vdw
 639         ielstart_vdw(i)=i+2
 640         ielend_vdw(i)=nct-1
 641       enddo
 642 #endif
 643       if (lprint) then
 644         write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,&
 645         ' absolute rank',MyRank
 646         write (iout,*) 'Electrostatic interaction array:'
 647         do i=iatel_s,iatel_e
 648           write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
 649         enddo
 650       endif ! lprint
 651 !     iscp=3
 652       iscp=2
 653 ! Partition the SC-p interaction array
 654 #ifdef MPI
 655       nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
 656       call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
 657       if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,&
 658         ' absolute rank',myrank,&
 659         ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,&
 660                     ' my_scp_inde',my_scp_inde
 661       iatscp_s=0
 662       iatscp_e=0
 663       ind_scpint=0
 664       ind_scpint_old=0
 665       do i=nnt,nct-1
 666         if (i.lt.nnt+iscp) then
 667 !d        write (iout,*) 'i.le.nnt+iscp'
 668           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
 669             iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),&
 670             iscpend(i,1),*14)
 671         else if (i.gt.nct-iscp) then
 672 !d        write (iout,*) 'i.gt.nct-iscp'
 673           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
 674             iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),&
 675             iscpend(i,1),*14)
 676         else
 677           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
 678             iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),&
 679            iscpend(i,1),*14)
 680           ii=nscp_gr(i)+1
 681           call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,&
 682             iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),&
 683             iscpend(i,ii),*14)
 684         endif
 685       enddo ! i
 686    14 continue
 687 #else
 688       iatscp_s=nnt
 689       iatscp_e=nct-1
 690       do i=nnt,nct-1
 691         if (i.lt.nnt+iscp) then
 692           nscp_gr(i)=1
 693           iscpstart(i,1)=i+iscp
 694           iscpend(i,1)=nct
 695         elseif (i.gt.nct-iscp) then
 696           nscp_gr(i)=1
 697           iscpstart(i,1)=nnt
 698           iscpend(i,1)=i-iscp
 699         else
 700           nscp_gr(i)=2
 701           iscpstart(i,1)=nnt
 702           iscpend(i,1)=i-iscp
 703           iscpstart(i,2)=i+iscp
 704           iscpend(i,2)=nct
 705         endif
 706       enddo ! i
 707 #endif
 708       if (iatscp_s.eq.0) iatscp_s=1
 709       if (lprint) then
 710         write (iout,'(a)') 'SC-p interaction array:'
 711         do i=iatscp_s,iatscp_e
 712           write (iout,'(i3,2(2x,2i3))') &
 713               i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
 714         enddo
 715       endif ! lprint
 716 ! Partition local interactions
 717 #ifdef MPI
 718       call int_bounds(nres-2,loc_start,loc_end)
 719       loc_start=loc_start+1
 720       loc_end=loc_end+1
 721       call int_bounds(nres-2,ithet_start,ithet_end)
 722       ithet_start=ithet_start+2
 723       ithet_end=ithet_end+2
 724       call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
 725       iturn3_start=iturn3_start+nnt
 726       iphi_start=iturn3_start+2
 727       iturn3_end=iturn3_end+nnt
 728       iphi_end=iturn3_end+2
 729       iturn3_start=iturn3_start-1
 730       iturn3_end=iturn3_end-1
 731       call int_bounds(nres-3,itau_start,itau_end)
 732       itau_start=itau_start+3
 733       itau_end=itau_end+3
 734       call int_bounds(nres-3,iphi1_start,iphi1_end)
 735       iphi1_start=iphi1_start+3
 736       iphi1_end=iphi1_end+3
 737       call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
 738       iturn4_start=iturn4_start+nnt
 739       iphid_start=iturn4_start+2
 740       iturn4_end=iturn4_end+nnt
 741       iphid_end=iturn4_end+2
 742       iturn4_start=iturn4_start-1
 743       iturn4_end=iturn4_end-1
 744       call int_bounds(nres-2,ibond_start,ibond_end)
 745       ibond_start=ibond_start+1
 746       ibond_end=ibond_end+1
 747       call int_bounds(nct-nnt,ibondp_start,ibondp_end)
 748       ibondp_start=ibondp_start+nnt
 749       ibondp_end=ibondp_end+nnt
 750       call int_bounds1(nres-1,ivec_start,ivec_end)
 751 !      print *,"Processor",myrank,fg_rank,fg_rank1,
 752 !     &  " ivec_start",ivec_start," ivec_end",ivec_end
 753       iset_start=loc_start+2
 754       iset_end=loc_end+2
 755       if (ndih_constr.eq.0) then
 756         idihconstr_start=1
 757         idihconstr_end=0
 758       else
 759         call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
 760       endif
 761 !      nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 762 !      nlen=nres-nnt+1
 763       nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 764       nlen=nres-nnt+1
 765       call int_bounds(nsumgrad,ngrad_start,ngrad_end)
 766       igrad_start=((2*nlen+1) &
 767          -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
 768       igrad_end=((2*nlen+1) &
 769          -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
 770 !el      allocate(jgrad_start(igrad_start:igrad_end))
 771 !el      allocate(jgrad_end(igrad_start:igrad_end)) !(maxres)
 772       jgrad_start(igrad_start)= &
 773          ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 &
 774          +igrad_start
 775       jgrad_end(igrad_start)=nres
 776       if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
 777       jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 &
 778           +igrad_end
 779       do i=igrad_start+1,igrad_end-1
 780         jgrad_start(i)=i+1
 781         jgrad_end(i)=nres
 782       enddo
 783       if (lprint) then
 784         write (*,*) 'Processor:',fg_rank,' CG group',kolor,&
 785        ' absolute rank',myrank,&
 786        ' loc_start',loc_start,' loc_end',loc_end,&
 787        ' ithet_start',ithet_start,' ithet_end',ithet_end,&
 788        ' iphi_start',iphi_start,' iphi_end',iphi_end,&
 789        ' iphid_start',iphid_start,' iphid_end',iphid_end,&
 790        ' ibond_start',ibond_start,' ibond_end',ibond_end,&
 791        ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,&
 792        ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,&
 793        ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,&
 794        ' ivec_start',ivec_start,' ivec_end',ivec_end,&
 795        ' iset_start',iset_start,' iset_end',iset_end,&
 796        ' idihconstr_start',idihconstr_start,' idihconstr_end',&
 797          idihconstr_end
 798        write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',&
 799          igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,&
 800          ' ngrad_end',ngrad_end
 801        do i=igrad_start,igrad_end
 802          write(*,*) 'Processor:',fg_rank,myrank,i,&
 803           jgrad_start(i),jgrad_end(i)
 804        enddo
 805       endif
 806       if (nfgtasks.gt.1) then
 807         call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,&
 808           MPI_INTEGER,FG_COMM1,IERROR)
 809         iaux=ivec_end-ivec_start+1
 810         call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,&
 811           MPI_INTEGER,FG_COMM1,IERROR)
 812         call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,&
 813           MPI_INTEGER,FG_COMM,IERROR)
 814         iaux=iset_end-iset_start+1
 815         call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,&
 816           MPI_INTEGER,FG_COMM,IERROR)
 817         call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,&
 818           MPI_INTEGER,FG_COMM,IERROR)
 819         iaux=ibond_end-ibond_start+1
 820         call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,&
 821           MPI_INTEGER,FG_COMM,IERROR)
 822         call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,&
 823           MPI_INTEGER,FG_COMM,IERROR)
 824         iaux=ithet_end-ithet_start+1
 825         call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,&
 826           MPI_INTEGER,FG_COMM,IERROR)
 827         call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,&
 828           MPI_INTEGER,FG_COMM,IERROR)
 829         iaux=iphi_end-iphi_start+1
 830         call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,&
 831           MPI_INTEGER,FG_COMM,IERROR)
 832         call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,&
 833           MPI_INTEGER,FG_COMM,IERROR)
 834         iaux=iphi1_end-iphi1_start+1
 835         call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,&
 836           MPI_INTEGER,FG_COMM,IERROR)
 837         do i=0,nfgtasks-1
 838           do j=1,nres
 839             ielstart_all(j,i)=0
 840             ielend_all(j,i)=0
 841           enddo
 842         enddo
 843         call MPI_Allgather(iturn3_start,1,MPI_INTEGER,&
 844           iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 845         call MPI_Allgather(iturn4_start,1,MPI_INTEGER,&
 846           iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 847         call MPI_Allgather(iturn3_end,1,MPI_INTEGER,&
 848           iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 849         call MPI_Allgather(iturn4_end,1,MPI_INTEGER,&
 850           iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 851         call MPI_Allgather(iatel_s,1,MPI_INTEGER,&
 852           iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 853         call MPI_Allgather(iatel_e,1,MPI_INTEGER,&
 854           iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
 855         call MPI_Allgather(ielstart(1),nres,MPI_INTEGER,&
 856           ielstart_all(1,0),nres,MPI_INTEGER,FG_COMM,IERROR)
 857         call MPI_Allgather(ielend(1),nres,MPI_INTEGER,&
 858           ielend_all(1,0),nres,MPI_INTEGER,FG_COMM,IERROR)
 859         if (lprint) then
 860         write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
 861         write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
 862         write (iout,*) "iturn3_start_all",&
 863           (iturn3_start_all(i),i=0,nfgtasks-1)
 864         write (iout,*) "iturn3_end_all",&
 865           (iturn3_end_all(i),i=0,nfgtasks-1)
 866         write (iout,*) "iturn4_start_all",&
 867           (iturn4_start_all(i),i=0,nfgtasks-1)
 868         write (iout,*) "iturn4_end_all",&
 869           (iturn4_end_all(i),i=0,nfgtasks-1)
 870         write (iout,*) "The ielstart_all array"
 871         do i=nnt,nct
 872           write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
 873         enddo
 874         write (iout,*) "The ielend_all array"
 875         do i=nnt,nct
 876           write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
 877         enddo
 878         call flush(iout)
 879         endif
 880         ntask_cont_from=0
 881         ntask_cont_to=0
 882         itask_cont_from(0)=fg_rank
 883         itask_cont_to(0)=fg_rank
 884         flag=.false.
 885 !el        allocate(iturn3_sent(4,iturn3_start:iturn3_end))
 886 !el        allocate(iturn4_sent(4,iturn4_start:iturn4_end)) !(4,maxres)
 887         do ii=iturn3_start,iturn3_end
 888           call add_int(ii,ii+2,iturn3_sent(1,ii),&
 889                       ntask_cont_to,itask_cont_to,flag)
 890         enddo
 891         do ii=iturn4_start,iturn4_end
 892           call add_int(ii,ii+3,iturn4_sent(1,ii),&
 893                       ntask_cont_to,itask_cont_to,flag)
 894         enddo
 895         do ii=iturn3_start,iturn3_end
 896           call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
 897         enddo
 898         do ii=iturn4_start,iturn4_end
 899           call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
 900         enddo
 901         if (lprint) then
 902         write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,&
 903          " ntask_cont_to",ntask_cont_to
 904         write (iout,*) "itask_cont_from",&
 905           (itask_cont_from(i),i=1,ntask_cont_from)
 906         write (iout,*) "itask_cont_to",&
 907           (itask_cont_to(i),i=1,ntask_cont_to)
 908         call flush(iout)
 909         endif
 910 !        write (iout,*) "Loop forward"
 911 !        call flush(iout)
 912         do i=iatel_s,iatel_e
 913 !          write (iout,*) "from loop i=",i
 914 !          call flush(iout)
 915           do j=ielstart(i),ielend(i)
 916             call add_int_from(i,j,ntask_cont_from,itask_cont_from)
 917           enddo
 918         enddo
 919 !        write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
 920 !     &     " iatel_e",iatel_e
 921 !        call flush(iout)
 922         nat_sent=0
 923         do i=iatel_s,iatel_e
 924 !          write (iout,*) "i",i," ielstart",ielstart(i),
 925 !     &      " ielend",ielend(i)
 926 !          call flush(iout)
 927           flag=.false.
 928           do j=ielstart(i),ielend(i)
 929             call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,&
 930                         itask_cont_to,flag)
 931           enddo
 932           if (flag) then
 933             nat_sent=nat_sent+1
 934             iat_sent(nat_sent)=i
 935           endif
 936         enddo
 937         if (lprint) then
 938         write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,&
 939          " ntask_cont_to",ntask_cont_to
 940         write (iout,*) "itask_cont_from",&
 941           (itask_cont_from(i),i=1,ntask_cont_from)
 942         write (iout,*) "itask_cont_to",&
 943           (itask_cont_to(i),i=1,ntask_cont_to)
 944         call flush(iout)
 945         write (iout,*) "iint_sent"
 946         do i=1,nat_sent
 947           ii=iat_sent(i)
 948           write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),&
 949             j=ielstart(ii),ielend(ii))
 950         enddo
 951         write (iout,*) "iturn3_sent iturn3_start",iturn3_start,&
 952           " iturn3_end",iturn3_end
 953         write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),&
 954            i=iturn3_start,iturn3_end)
 955         write (iout,*) "iturn4_sent iturn4_start",iturn4_start,&
 956           " iturn4_end",iturn4_end
 957         write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),&
 958            i=iturn4_start,iturn4_end)
 959         call flush(iout)
 960         endif
 961         call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,&
 962          ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
 963 !        write (iout,*) "Gather ntask_cont_from ended"
 964 !        call flush(iout)
 965         call MPI_Gather(itask_cont_from(0),nfgtasks,MPI_INTEGER,&
 966          itask_cont_from_all(0,0),nfgtasks,MPI_INTEGER,king,&
 967          FG_COMM,IERR)
 968 !        write (iout,*) "Gather itask_cont_from ended"
 969 !        call flush(iout)
 970         call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,&
 971          1,MPI_INTEGER,king,FG_COMM,IERR)
 972 !        write (iout,*) "Gather ntask_cont_to ended"
 973 !        call flush(iout)
 974         call MPI_Gather(itask_cont_to,nfgtasks,MPI_INTEGER,&
 975          itask_cont_to_all,nfgtasks,MPI_INTEGER,king,FG_COMM,IERR)
 976 !        write (iout,*) "Gather itask_cont_to ended"
 977 !        call flush(iout)
 978         if (fg_rank.eq.king) then
 979           write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
 980           do i=0,nfgtasks-1
 981             write (iout,'(20i4)') i,ntask_cont_from_all(i),&
 982               (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
 983           enddo
 984           write (iout,*)
 985           call flush(iout)
 986           write (iout,*) "Contact send task map (proc, #tasks, tasks)"
 987           do i=0,nfgtasks-1
 988             write (iout,'(20i4)') i,ntask_cont_to_all(i),&
 989              (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
 990           enddo
 991           write (iout,*)
 992           call flush(iout)
 993 ! Check if every send will have a matching receive
 994           ncheck_to=0
 995           ncheck_from=0
 996           do i=0,nfgtasks-1
 997             ncheck_to=ncheck_to+ntask_cont_to_all(i)
 998             ncheck_from=ncheck_from+ntask_cont_from_all(i)
 999           enddo
1000           write (iout,*) "Control sums",ncheck_from,ncheck_to
1001           if (ncheck_from.ne.ncheck_to) then
1002             write (iout,*) "Error: #receive differs from #send."
1003             write (iout,*) "Terminating program...!"
1004             call flush(iout)
1005             flag=.false.
1006           else
1007             flag=.true.
1008             do i=0,nfgtasks-1
1009               do j=1,ntask_cont_to_all(i)
1010                 ii=itask_cont_to_all(j,i)
1011                 do k=1,ntask_cont_from_all(ii)
1012                   if (itask_cont_from_all(k,ii).eq.i) then
1013                     if(lprint)write(iout,*)"Matching send/receive",i,ii
1014                     exit
1015                   endif
1016                 enddo
1017                 if (k.eq.ntask_cont_from_all(ii)+1) then
1018                   flag=.false.
1019                   write (iout,*) "Error: send by",j," to",ii,&
1020                     " would have no matching receive"
1021                 endif
1022               enddo
1023             enddo
1024           endif
1025           if (.not.flag) then
1026             write (iout,*) "Unmatched sends; terminating program"
1027             call flush(iout)
1028           endif
1029         endif
1030         call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
1031 !        write (iout,*) "flag broadcast ended flag=",flag
1032 !        call flush(iout)
1033         if (.not.flag) then
1034           call MPI_Finalize(IERROR)
1035           stop "Error in INIT_INT_TABLE: unmatched send/receive."
1036         endif
1037         call MPI_Comm_group(FG_COMM,fg_group,IERR)
1038 !        write (iout,*) "MPI_Comm_group ended"
1039 !        call flush(iout)
1040         call MPI_Group_incl(fg_group,ntask_cont_from+1,&
1041           itask_cont_from(0),CONT_FROM_GROUP,IERR)
1042         call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),&
1043           CONT_TO_GROUP,IERR)
1044         do i=1,nat_sent
1045           ii=iat_sent(i)
1046           iaux=4*(ielend(ii)-ielstart(ii)+1)
1047           call MPI_Group_translate_ranks(fg_group,iaux,&
1048             iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,&
1049             iint_sent_local(1,ielstart(ii),i),IERR )
1050 !          write (iout,*) "Ranks translated i=",i
1051 !          call flush(iout)
1052         enddo
1053         iaux=4*(iturn3_end-iturn3_start+1)
1054         call MPI_Group_translate_ranks(fg_group,iaux,&
1055            iturn3_sent(1,iturn3_start),CONT_TO_GROUP,&
1056            iturn3_sent_local(1,iturn3_start),IERR)
1057         iaux=4*(iturn4_end-iturn4_start+1)
1058         call MPI_Group_translate_ranks(fg_group,iaux,&
1059            iturn4_sent(1,iturn4_start),CONT_TO_GROUP,&
1060            iturn4_sent_local(1,iturn4_start),IERR)
1061         if (lprint) then
1062         write (iout,*) "iint_sent_local"
1063         do i=1,nat_sent
1064           ii=iat_sent(i)
1065           write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),&
1066             j=ielstart(ii),ielend(ii))
1067           call flush(iout)
1068         enddo
1069         write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,&
1070           " iturn3_end",iturn3_end
1071         write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),&
1072            i=iturn3_start,iturn3_end)
1073         write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,&
1074           " iturn4_end",iturn4_end
1075         write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),&
1076            i=iturn4_start,iturn4_end)
1077         call flush(iout)
1078         endif
1079         call MPI_Group_free(fg_group,ierr)
1080         call MPI_Group_free(cont_from_group,ierr)
1081         call MPI_Group_free(cont_to_group,ierr)
1082         call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
1083         call MPI_Type_commit(MPI_UYZ,IERROR)
1084         call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,&
1085           IERROR)
1086         call MPI_Type_commit(MPI_UYZGRAD,IERROR)
1087         call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
1088         call MPI_Type_commit(MPI_MU,IERROR)
1089         call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
1090         call MPI_Type_commit(MPI_MAT1,IERROR)
1091         call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
1092         call MPI_Type_commit(MPI_MAT2,IERROR)
1093         call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
1094         call MPI_Type_commit(MPI_THET,IERROR)
1095         call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
1096         call MPI_Type_commit(MPI_GAM,IERROR)
1097
1098 !el        allocate(lentyp(0:nfgtasks-1))
1099 #ifndef MATGATHER
1100 ! 9/22/08 Derived types to send matrices which appear in correlation terms
1101         do i=0,nfgtasks-1
1102           if (ivec_count(i).eq.ivec_count(0)) then
1103             lentyp(i)=0
1104           else
1105             lentyp(i)=1
1106           endif
1107         enddo
1108         do ind_typ=lentyp(0),lentyp(nfgtasks-1)
1109         if (ind_typ.eq.0) then
1110           ichunk=ivec_count(0)
1111         else
1112           ichunk=ivec_count(1)
1113         endif
1114 !        do i=1,4
1115 !          blocklengths(i)=4
1116 !        enddo
1117 !        displs(1)=0
1118 !        do i=2,4
1119 !          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1120 !        enddo
1121 !        do i=1,4
1122 !          blocklengths(i)=blocklengths(i)*ichunk
1123 !        enddo
1124 !        write (iout,*) "blocklengths and displs"
1125 !        do i=1,4
1126 !          write (iout,*) i,blocklengths(i),displs(i)
1127 !        enddo
1128 !        call flush(iout)
1129 !        call MPI_Type_indexed(4,blocklengths(1),displs(1),
1130 !     &    MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
1131 !        call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
1132 !        write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
1133 !        do i=1,4
1134 !          blocklengths(i)=2
1135 !        enddo
1136 !        displs(1)=0
1137 !        do i=2,4
1138 !          displs(i)=displs(i-1)+blocklengths(i-1)*maxres
1139 !        enddo
1140 !        do i=1,4
1141 !          blocklengths(i)=blocklengths(i)*ichunk
1142 !        enddo
1143 !        write (iout,*) "blocklengths and displs"
1144 !        do i=1,4
1145 !          write (iout,*) i,blocklengths(i),displs(i)
1146 !        enddo
1147 !        call flush(iout)
1148 !        call MPI_Type_indexed(4,blocklengths(1),displs(1),
1149 !     &    MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
1150 !        call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
1151 !        write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
1152         do i=1,8
1153           blocklengths(i)=2
1154         enddo
1155         displs(1)=0
1156         do i=2,8
1157           displs(i)=displs(i-1)+blocklengths(i-1)*nres !maxres
1158         enddo
1159         do i=1,15
1160           blocklengths(i)=blocklengths(i)*ichunk
1161         enddo
1162         call MPI_Type_indexed(8,blocklengths,displs,&
1163           MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
1164         call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
1165         do i=1,8
1166           blocklengths(i)=4
1167         enddo
1168         displs(1)=0
1169         do i=2,8
1170           displs(i)=displs(i-1)+blocklengths(i-1)*nres !maxres
1171         enddo
1172         do i=1,15
1173           blocklengths(i)=blocklengths(i)*ichunk
1174         enddo
1175         call MPI_Type_indexed(8,blocklengths,displs,&
1176           MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
1177         call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
1178         do i=1,6
1179           blocklengths(i)=4
1180         enddo
1181         displs(1)=0
1182         do i=2,6
1183           displs(i)=displs(i-1)+blocklengths(i-1)*nres !maxres
1184         enddo
1185         do i=1,6
1186           blocklengths(i)=blocklengths(i)*ichunk
1187         enddo
1188         call MPI_Type_indexed(6,blocklengths,displs,&
1189           MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
1190         call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
1191         do i=1,2
1192           blocklengths(i)=8
1193         enddo
1194         displs(1)=0
1195         do i=2,2
1196           displs(i)=displs(i-1)+blocklengths(i-1)*nres !maxres
1197         enddo
1198         do i=1,2
1199           blocklengths(i)=blocklengths(i)*ichunk
1200         enddo
1201         call MPI_Type_indexed(2,blocklengths,displs,&
1202           MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
1203         call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
1204         do i=1,4
1205           blocklengths(i)=1
1206         enddo
1207         displs(1)=0
1208         do i=2,4
1209           displs(i)=displs(i-1)+blocklengths(i-1)*nres !maxres
1210         enddo
1211         do i=1,4
1212           blocklengths(i)=blocklengths(i)*ichunk
1213         enddo
1214         call MPI_Type_indexed(4,blocklengths,displs,&
1215           MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
1216         call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
1217         enddo
1218 #endif
1219       endif
1220       iint_start=ivec_start+1
1221       iint_end=ivec_end+1
1222       do i=0,nfgtasks-1
1223           iint_count(i)=ivec_count(i)
1224           iint_displ(i)=ivec_displ(i)
1225           ivec_displ(i)=ivec_displ(i)-1
1226           iset_displ(i)=iset_displ(i)-1
1227           ithet_displ(i)=ithet_displ(i)-1
1228           iphi_displ(i)=iphi_displ(i)-1
1229           iphi1_displ(i)=iphi1_displ(i)-1
1230           ibond_displ(i)=ibond_displ(i)-1
1231       enddo
1232       if (nfgtasks.gt.1 .and. fg_rank.eq.king &
1233           .and. (me.eq.0 .or. .not. out1file)) then
1234         write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
1235         do i=0,nfgtasks-1
1236           write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),&
1237             iset_count(i)
1238         enddo
1239         write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,&
1240           " iphi1_start",iphi1_start," iphi1_end",iphi1_end
1241         write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
1242         do i=0,nfgtasks-1
1243           write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),&
1244             iphi1_displ(i)
1245         enddo
1246         write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',&
1247           nele_int_tot,' electrostatic and ',nscp_int_tot,&
1248           ' SC-p interactions','were distributed among',nfgtasks,&
1249           ' fine-grain processors.'
1250       endif
1251 #else
1252       loc_start=2
1253       loc_end=nres-1
1254       ithet_start=3
1255       ithet_end=nres
1256       iturn3_start=nnt
1257       iturn3_end=nct-3
1258       iturn4_start=nnt
1259       iturn4_end=nct-4
1260       iphi_start=nnt+3
1261       iphi_end=nct
1262       iphi1_start=4
1263       iphi1_end=nres
1264       idihconstr_start=1
1265       idihconstr_end=ndih_constr
1266       iphid_start=iphi_start
1267       iphid_end=iphi_end-1
1268       itau_start=4
1269       itau_end=nres
1270       ibond_start=2
1271       ibond_end=nres-1
1272       ibondp_start=nnt
1273       ibondp_end=nct-1
1274       ivec_start=1
1275       ivec_end=nres-1
1276       iset_start=3
1277       iset_end=nres+1
1278       iint_start=2
1279       iint_end=nres-1
1280 #endif
1281 !el       common /przechowalnia/
1282       deallocate(iturn3_start_all)
1283       deallocate(iturn3_end_all)
1284       deallocate(iturn4_start_all)
1285       deallocate(iturn4_end_all)
1286       deallocate(iatel_s_all)
1287       deallocate(iatel_e_all)
1288       deallocate(ielstart_all)
1289       deallocate(ielend_all)
1290
1291       deallocate(ntask_cont_from_all)
1292       deallocate(ntask_cont_to_all)
1293       deallocate(itask_cont_from_all)
1294       deallocate(itask_cont_to_all)
1295 !el----------
1296       return
1297       end subroutine init_int_table
1298 #ifdef MPI
1299 !-----------------------------------------------------------------------------
1300       subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
1301
1302 !el      implicit none
1303 !      include "DIMENSIONS"
1304 !      include "COMMON.INTERACT"
1305 !      include "COMMON.SETUP"
1306 !      include "COMMON.IOUNITS"
1307       integer :: ii,jj,ntask_cont_to
1308       integer,dimension(4) :: itask
1309       integer :: itask_cont_to(0:nfgtasks-1)    !(0:max_fg_procs-1)
1310       logical :: flag
1311 !el      integer,dimension(0:nfgtasks) :: iturn3_start_all,iturn3_end_all,iturn4_start_all,&
1312 !el       iturn4_end_all,iatel_s_all,iatel_e_all        !(0:max_fg_procs)
1313 !el      integer,dimension(nres,0:nfgtasks-1) :: ielstart_all,ielend_all        !(maxres,0:max_fg_procs-1)
1314 !el      common /przechowalnia/ iturn3_start_all,iturn3_end_all,iturn4_start_all,&
1315 !el       iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1316       integer :: iproc,isent,k,l
1317 ! Determines whether to send interaction ii,jj to other processors; a given
1318 ! interaction can be sent to at most 2 processors.
1319 ! Sets flag=.true. if interaction ii,jj needs to be sent to at least
1320 ! one processor, otherwise flag is unchanged from the input value.
1321       isent=0
1322       itask(1)=fg_rank
1323       itask(2)=fg_rank
1324       itask(3)=fg_rank
1325       itask(4)=fg_rank
1326 !      write (iout,*) "ii",ii," jj",jj
1327 ! Loop over processors to check if anybody could need interaction ii,jj
1328       do iproc=0,fg_rank-1
1329 ! Check if the interaction matches any turn3 at iproc
1330         do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1331           l=k+2
1332           if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 &
1333          .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) &
1334           then
1335 !            write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
1336 !            call flush(iout)
1337             flag=.true.
1338             if (iproc.ne.itask(1).and.iproc.ne.itask(2) &
1339               .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1340               isent=isent+1
1341               itask(isent)=iproc
1342               call add_task(iproc,ntask_cont_to,itask_cont_to)
1343             endif
1344           endif
1345         enddo
1346 ! Check if the interaction matches any turn4 at iproc
1347         do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1348           l=k+3
1349           if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 &
1350          .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) &
1351           then
1352 !            write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
1353 !            call flush(iout)
1354             flag=.true.
1355             if (iproc.ne.itask(1).and.iproc.ne.itask(2) &
1356               .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1357               isent=isent+1
1358               itask(isent)=iproc
1359               call add_task(iproc,ntask_cont_to,itask_cont_to)
1360             endif
1361           endif
1362         enddo
1363         if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and. &
1364         iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
1365           if (ielstart_all(ii-1,iproc).le.jj-1.and. &
1366               ielend_all(ii-1,iproc).ge.jj-1) then
1367             flag=.true.
1368             if (iproc.ne.itask(1).and.iproc.ne.itask(2) &
1369               .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
1370               isent=isent+1
1371               itask(isent)=iproc
1372               call add_task(iproc,ntask_cont_to,itask_cont_to)
1373             endif
1374           endif
1375           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         endif
1386       enddo
1387       return
1388       end subroutine add_int
1389 !-----------------------------------------------------------------------------
1390       subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
1391
1392 !el      use MPI_data
1393 !el      implicit none
1394 !      include "DIMENSIONS"
1395 !      include "COMMON.INTERACT"
1396 !      include "COMMON.SETUP"
1397 !      include "COMMON.IOUNITS"
1398       integer :: ii,jj,itask(2),ntask_cont_from,&
1399        itask_cont_from(0:nfgtasks-1)    !(0:max_fg_procs)
1400       logical :: flag
1401 !el      integer,dimension(0:nfgtasks) :: iturn3_start_all,iturn3_end_all,&
1402 !el       iturn4_start_all,iturn4_end_all,iatel_s_all,iatel_e_all       !(0:max_fg_procs)
1403 !el      integer,dimension(nres,0:nfgtasks-1) :: ielstart_all,ielend_all        !(maxres,0:max_fg_procs-1)
1404 !el      common /przechowalnia/ iturn3_start_all,iturn3_end_all,iturn4_start_all,&
1405 !el       iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
1406       integer :: iproc,k,l
1407       do iproc=fg_rank+1,nfgtasks-1
1408         do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
1409           l=k+2
1410           if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 &
1411          .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) &
1412           then
1413 !            write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
1414             call add_task(iproc,ntask_cont_from,itask_cont_from)
1415           endif
1416         enddo
1417         do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
1418           l=k+3
1419           if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 &
1420          .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) &
1421           then
1422 !            write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
1423             call add_task(iproc,ntask_cont_from,itask_cont_from)
1424           endif
1425         enddo
1426         if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
1427           if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc)) &
1428           then
1429             if (jj+1.ge.ielstart_all(ii+1,iproc).and. &
1430                 jj+1.le.ielend_all(ii+1,iproc)) then
1431               call add_task(iproc,ntask_cont_from,itask_cont_from)
1432             endif
1433             if (jj-1.ge.ielstart_all(ii+1,iproc).and. &
1434                 jj-1.le.ielend_all(ii+1,iproc)) then
1435               call add_task(iproc,ntask_cont_from,itask_cont_from)
1436             endif
1437           endif
1438           if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc)) &
1439           then
1440             if (jj-1.ge.ielstart_all(ii-1,iproc).and. &
1441                 jj-1.le.ielend_all(ii-1,iproc)) then
1442               call add_task(iproc,ntask_cont_from,itask_cont_from)
1443             endif
1444             if (jj+1.ge.ielstart_all(ii-1,iproc).and. &
1445                 jj+1.le.ielend_all(ii-1,iproc)) then
1446                call add_task(iproc,ntask_cont_from,itask_cont_from)
1447             endif
1448           endif
1449         endif
1450       enddo
1451       return
1452       end subroutine add_int_from
1453 !-----------------------------------------------------------------------------
1454       subroutine add_task(iproc,ntask_cont,itask_cont)
1455
1456 !el      implicit none
1457 !      include "DIMENSIONS"
1458       integer :: iproc,ntask_cont,itask_cont(0:nfgtasks-1)      !(0:max_fg_procs-1)
1459       integer :: ii
1460       do ii=1,ntask_cont
1461         if (itask_cont(ii).eq.iproc) return
1462       enddo
1463       ntask_cont=ntask_cont+1
1464       itask_cont(ntask_cont)=iproc
1465       return
1466       end subroutine add_task
1467 #endif
1468 !-----------------------------------------------------------------------------
1469 #if defined MPI || defined WHAM_RUN
1470       subroutine int_partition(int_index,lower_index,upper_index,atom,&
1471        at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
1472
1473 !      implicit real*8 (a-h,o-z)
1474 !      include 'DIMENSIONS'
1475 !      include 'COMMON.IOUNITS'
1476       integer :: int_index,lower_index,upper_index,atom,at_start,at_end,&
1477        first_atom,last_atom,int_gr,jat_start,jat_end,int_index_old
1478       logical :: lprn
1479       lprn=.false.
1480       if (lprn) write (iout,*) 'int_index=',int_index
1481       int_index_old=int_index
1482       int_index=int_index+last_atom-first_atom+1
1483       if (lprn) &
1484          write (iout,*) 'int_index=',int_index,&
1485                      ' int_index_old',int_index_old,&
1486                      ' lower_index=',lower_index,&
1487                      ' upper_index=',upper_index,&
1488                      ' atom=',atom,' first_atom=',first_atom,&
1489                      ' last_atom=',last_atom
1490       if (int_index.ge.lower_index) then
1491         int_gr=int_gr+1
1492         if (at_start.eq.0) then
1493           at_start=atom
1494           jat_start=first_atom-1+lower_index-int_index_old
1495         else
1496           jat_start=first_atom
1497         endif
1498         if (lprn) write (iout,*) 'jat_start',jat_start
1499         if (int_index.ge.upper_index) then
1500           at_end=atom
1501           jat_end=first_atom-1+upper_index-int_index_old
1502           return 1
1503         else
1504           jat_end=last_atom
1505         endif
1506         if (lprn) write (iout,*) 'jat_end',jat_end
1507       endif
1508       return
1509       end subroutine int_partition
1510 #endif
1511 !-----------------------------------------------------------------------------
1512       subroutine hpb_partition
1513
1514 !      implicit real*8 (a-h,o-z)
1515 !      include 'DIMENSIONS'
1516 #ifdef MPI
1517       include 'mpif.h'
1518 #endif
1519 !      include 'COMMON.SBRIDGE'
1520 !      include 'COMMON.IOUNITS'
1521 !      include 'COMMON.SETUP'
1522 #ifdef MPI
1523       call int_bounds(nhpb,link_start,link_end)
1524       write (iout,*) 'Processor',fg_rank,' CG group',kolor,&
1525         ' absolute rank',MyRank,&
1526         ' nhpb',nhpb,' link_start=',link_start,&
1527         ' link_end',link_end
1528 #else
1529       link_start=1
1530       link_end=nhpb
1531 #endif
1532       return
1533       end subroutine hpb_partition
1534 !-----------------------------------------------------------------------------
1535 ! misc.f in module io_common
1536 !-----------------------------------------------------------------------------
1537 !-----------------------------------------------------------------------------
1538 ! parmread.F
1539 !-----------------------------------------------------------------------------
1540       subroutine getenv_loc(var, val)
1541
1542       character(*) :: var, val
1543
1544 #ifdef WINIFL
1545       character(len=2000) :: line
1546 !el      external ilen
1547
1548       open (196,file='env',status='old',readonly,shared)
1549       iread=0
1550 !      write(*,*)'looking for ',var
1551 10    read(196,*,err=11,end=11)line
1552       iread=index(line,var)
1553 !      write(*,*)iread,' ',var,' ',line
1554       if (iread.eq.0) go to 10
1555 !      write(*,*)'---> ',line
1556 11    continue
1557       if(iread.eq.0) then
1558 !       write(*,*)'CHUJ'
1559        val=''
1560       else
1561        iread=iread+ilen(var)+1
1562        read (line(iread:),*,err=12,end=12) val
1563 !       write(*,*)'OK: ',var,' = ',val
1564       endif
1565       close(196)
1566       return
1567 12    val=''
1568       close(196)
1569 #elif (defined CRAY)
1570       integer :: lennam,lenval,ierror
1571 !
1572 !        getenv using a POSIX call, useful on the T3D
1573 !        Sept 1996, comment out error check on advice of H. Pritchard
1574 !
1575       lennam = len(var)
1576       if(lennam.le.0) stop '--error calling getenv--'
1577       call pxfgetenv(var,lennam,val,lenval,ierror)
1578 !-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--'
1579 #else
1580       call getenv(var,val)
1581 #endif
1582
1583       return
1584       end subroutine getenv_loc
1585 !-----------------------------------------------------------------------------
1586 ! readrtns_CSA.F
1587 !-----------------------------------------------------------------------------
1588       subroutine setup_var
1589
1590       integer :: i
1591 !      implicit real*8 (a-h,o-z)
1592 !      include 'DIMENSIONS'
1593 !      include 'COMMON.IOUNITS'
1594 !      include 'COMMON.GEO'
1595 !      include 'COMMON.VAR'
1596 !      include 'COMMON.INTERACT'
1597 !      include 'COMMON.LOCAL'
1598 !      include 'COMMON.NAMES'
1599 !      include 'COMMON.CHAIN'
1600 !      include 'COMMON.FFIELD'
1601 !      include 'COMMON.SBRIDGE'
1602 !      include 'COMMON.HEADER'
1603 !      include 'COMMON.CONTROL'
1604 !      include 'COMMON.DBASE'
1605 !      include 'COMMON.THREAD'
1606 !      include 'COMMON.TIME1'
1607 ! Set up variable list.
1608       ntheta=nres-2
1609       nphi=nres-3
1610       nvar=ntheta+nphi
1611       nside=0
1612       do i=2,nres-1
1613 #ifdef WHAM_RUN
1614         if (itype(i).ne.10) then
1615 #else
1616         if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
1617 #endif
1618           nside=nside+1
1619           ialph(i,1)=nvar+nside
1620           ialph(nside,2)=i
1621         endif
1622       enddo
1623       if (indphi.gt.0) then
1624         nvar=nphi
1625       else if (indback.gt.0) then
1626         nvar=nphi+ntheta
1627       else
1628         nvar=nvar+2*nside
1629       endif
1630 !d    write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1)
1631       return
1632       end subroutine setup_var
1633 !-----------------------------------------------------------------------------
1634 ! rescode.f
1635 !-----------------------------------------------------------------------------
1636       integer function rescode(iseq,nam,itype)
1637
1638       use io_base, only: ucase
1639 !      implicit real*8 (a-h,o-z)
1640 !      include 'DIMENSIONS'
1641 !      include 'COMMON.NAMES'
1642 !      include 'COMMON.IOUNITS'
1643       character(len=3) :: nam   !,ucase
1644       integer :: iseq,itype,i
1645
1646       if (itype.eq.0) then
1647
1648       do i=-ntyp1,ntyp1
1649         if (ucase(nam).eq.restyp(i)) then
1650           rescode=i
1651           return
1652         endif
1653       enddo
1654
1655       else
1656
1657       do i=-ntyp1,ntyp1
1658         if (nam(1:1).eq.onelet(i)) then
1659           rescode=i
1660           return
1661         endif
1662       enddo
1663
1664       endif
1665       write (iout,10) iseq,nam
1666       stop
1667    10 format ('**** Error - residue',i4,' has an unresolved name ',a3)
1668       end function rescode
1669 !-----------------------------------------------------------------------------
1670 ! timing.F
1671 !-----------------------------------------------------------------------------
1672 ! $Date: 1994/10/05 16:41:52 $
1673 ! $Revision: 2.2 $
1674 !
1675       subroutine set_timers
1676 !
1677 !el      implicit none
1678 !el      real(kind=8) :: tcpu
1679 !      include 'COMMON.TIME1'
1680 !#ifdef MP
1681 #ifdef MPI
1682       include 'mpif.h'
1683 #endif
1684 ! Diminish the assigned time limit a little so that there is some time to
1685 ! end a batch job
1686 !     timlim=batime-150.0
1687 ! Calculate the initial time, if it is not zero (e.g. for the SUN).
1688       stime=tcpu()
1689 #ifndef WHAM_RUN
1690 #ifdef MPI
1691       walltime=MPI_WTIME()
1692       time_reduce=0.0d0
1693       time_allreduce=0.0d0
1694       time_bcast=0.0d0
1695       time_gather=0.0d0
1696       time_sendrecv=0.0d0
1697       time_scatter=0.0d0
1698       time_scatter_fmat=0.0d0
1699       time_scatter_ginv=0.0d0
1700       time_scatter_fmatmult=0.0d0
1701       time_scatter_ginvmult=0.0d0
1702       time_barrier_e=0.0d0
1703       time_barrier_g=0.0d0
1704       time_enecalc=0.0d0
1705       time_sumene=0.0d0
1706       time_lagrangian=0.0d0
1707       time_sumgradient=0.0d0
1708       time_intcartderiv=0.0d0
1709       time_inttocart=0.0d0
1710       time_ginvmult=0.0d0
1711       time_fricmatmult=0.0d0
1712       time_cartgrad=0.0d0
1713       time_bcastc=0.0d0
1714       time_bcast7=0.0d0
1715       time_bcastw=0.0d0
1716       time_intfcart=0.0d0
1717       time_vec=0.0d0
1718       time_mat=0.0d0
1719       time_fric=0.0d0
1720       time_stoch=0.0d0
1721       time_fricmatmult=0.0d0
1722       time_fsample=0.0d0
1723 #endif
1724 #endif
1725 !d    print *,' in SET_TIMERS stime=',stime
1726       return
1727       end subroutine set_timers
1728 !-----------------------------------------------------------------------------
1729       logical function stopx(nf)
1730 ! This function returns .true. if one of the following reasons to exit SUMSL
1731 ! occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block:
1732 !
1733 !... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false.
1734 !...           1 - Time up in current node;
1735 !...           2 - STOP signal was received from another node because the
1736 !...               node's task was accomplished (parallel only);
1737 !...          -1 - STOP signal was received from another node because of error;
1738 !...          -2 - STOP signal was received from another node, because
1739 !...               the node's time was up.
1740 !      implicit real*8 (a-h,o-z)
1741 !      include 'DIMENSIONS'
1742 !el#ifdef WHAM_RUN
1743 !el      use control_data, only:WhatsUp
1744 !el#endif
1745 #ifdef MP
1746 !el      use MPI_data   !include 'COMMON.INFO'
1747       include 'mpif.h'
1748 #endif
1749       integer :: nf
1750 !el      logical :: ovrtim
1751
1752 !      include 'COMMON.IOUNITS'
1753 !      include 'COMMON.TIME1'
1754       integer :: Kwita
1755
1756 !d    print *,'Processor',MyID,' NF=',nf
1757 !d      write (iout,*) "stopx: ",nf
1758 #ifndef WHAM_RUN
1759 #ifndef MPI
1760       if (ovrtim()) then
1761 ! Finish if time is up.
1762          stopx = .true.
1763          WhatsUp=1
1764 #ifdef MPL
1765       else if (mod(nf,100).eq.0) then
1766 ! Other processors might have finished. Check this every 100th function
1767 ! evaluation.
1768 ! Master checks if any other processor has sent accepted conformation(s) to it.
1769          if (MyID.ne.MasterID) call receive_mcm_info
1770          if (MyID.eq.MasterID) call receive_conf
1771 !d       print *,'Processor ',MyID,' is checking STOP: nf=',nf
1772          call recv_stop_sig(Kwita)
1773          if (Kwita.eq.-1) then
1774            write (iout,'(a,i4,a,i5)') 'Processor',&
1775            MyID,' has received STOP signal in STOPX; NF=',nf
1776            write (*,'(a,i4,a,i5)') 'Processor',&
1777            MyID,' has received STOP signal in STOPX; NF=',nf
1778            stopx=.true.
1779            WhatsUp=2
1780          elseif (Kwita.eq.-2) then
1781            write (iout,*) &
1782           'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
1783            write (*,*) &
1784           'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
1785            WhatsUp=-2
1786            stopx=.true.
1787          else if (Kwita.eq.-3) then
1788            write (iout,*) &
1789           'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
1790            write (*,*) &
1791           'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
1792            WhatsUp=-1
1793            stopx=.true.
1794          else
1795            stopx=.false.
1796            WhatsUp=0
1797          endif
1798 #endif
1799       else
1800          stopx = .false.
1801          WhatsUp=0
1802       endif
1803 #else
1804       stopx=.false.
1805 !d      write (iout,*) "stopx set at .false."
1806 #endif
1807
1808 #ifdef OSF
1809 ! Check for FOUND_NAN flag
1810       if (FOUND_NAN) then
1811         write(iout,*)"   ***   stopx : Found a NaN"
1812         stopx=.true.
1813       endif
1814 #endif
1815 #else
1816       if (ovrtim()) then
1817 ! Finish if time is up.
1818          stopx = .true.
1819          WhatsUp=1
1820       else if (cutoffviol) then
1821         stopx = .true.
1822         WhatsUp=2
1823       else
1824         stopx=.false.
1825       endif
1826 #endif
1827       return
1828       end function stopx
1829 !-----------------------------------------------------------------------------
1830       logical function ovrtim()
1831
1832 !      include 'DIMENSIONS'
1833 !      include 'COMMON.IOUNITS'
1834 !      include 'COMMON.TIME1'
1835 !el      real(kind=8) :: tcpu
1836       real(kind=8) :: curtim
1837 #ifdef MPI
1838       include "mpif.h"
1839       curtim = MPI_Wtime()-walltime
1840 #else
1841       curtim= tcpu()
1842 #endif
1843 !  curtim is the current time in seconds.
1844 !      write (iout,*) "curtim",curtim," timlim",timlim," safety",safety
1845 #ifndef WHAM_RUN
1846       if (curtim .ge. timlim - safety) then
1847         write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') &
1848         "***************** Elapsed time (",curtim,&
1849         " s) is within the safety limit (",safety,&
1850         " s) of the allocated time (",timlim," s). Terminating."
1851         ovrtim=.true.
1852       else
1853         ovrtim=.false.
1854       endif
1855 #else
1856       ovrtim=.false.
1857 #endif
1858 !elwrite (iout,*) "ovrtim",ovrtim
1859       return
1860       end function ovrtim
1861 !-----------------------------------------------------------------------------
1862       real(kind=8) function tcpu()
1863
1864 !      include 'COMMON.TIME1'
1865       real(kind=8) :: seconds
1866 #ifdef ES9000
1867 !***************************
1868 ! Next definition for EAGLE (ibm-es9000)
1869       real(kind=8) :: micseconds
1870       integer :: rcode
1871       tcpu=cputime(micseconds,rcode)
1872       tcpu=(micseconds/1.0E6) - stime
1873 !***************************
1874 #endif
1875 #ifdef SUN
1876 !***************************
1877 ! Next definitions for sun
1878       REAL(kind=8) ::  ECPU,ETIME,ETCPU
1879       real(kind=8),dimension(2) :: tarray
1880       tcpu=etime(tarray)
1881       tcpu=tarray(1)
1882 !***************************
1883 #endif
1884 #ifdef KSR
1885 !***************************
1886 ! Next definitions for ksr
1887 ! this function uses the ksr timer ALL_SECONDS from the PMON library to
1888 ! return the elapsed time in seconds
1889       tcpu= all_seconds() - stime
1890 !***************************
1891 #endif
1892 #ifdef SGI
1893 !***************************
1894 ! Next definitions for sgi
1895       real(kind=4) :: timar(2), etime
1896       seconds = etime(timar)
1897 !d    print *,'seconds=',seconds,' stime=',stime
1898 !      usrsec = timar(1)
1899 !      syssec = timar(2)
1900       tcpu=seconds - stime
1901 !***************************
1902 #endif
1903
1904 #ifdef LINUX
1905 !***************************
1906 ! Next definitions for sgi
1907       real(kind=4) :: timar(2), etime
1908       seconds = etime(timar)
1909 !d    print *,'seconds=',seconds,' stime=',stime
1910 !      usrsec = timar(1)
1911 !      syssec = timar(2)
1912       tcpu=seconds - stime
1913 !***************************
1914 #endif
1915
1916
1917 #ifdef CRAY
1918 !***************************
1919 ! Next definitions for Cray
1920 !     call date(curdat)
1921 !     curdat=curdat(1:9)
1922 !     call clock(curtim)
1923 !     curtim=curtim(1:8)
1924       cpusec = second()
1925       tcpu=cpusec - stime
1926 !***************************
1927 #endif
1928 #ifdef AIX
1929 !***************************
1930 ! Next definitions for RS6000
1931        integer(kind=4) :: i1,mclock
1932        i1 = mclock()
1933        tcpu = (i1+0.0D0)/100.0D0
1934 #endif
1935 #ifdef WINPGI
1936 !***************************
1937 ! next definitions for windows NT Digital fortran
1938        real(kind=4) :: time_real
1939        call cpu_time(time_real)
1940        tcpu = time_real
1941 #endif
1942 #ifdef WINIFL
1943 !***************************
1944 ! next definitions for windows NT Digital fortran
1945        real(kind=4) :: time_real
1946        call cpu_time(time_real)
1947        tcpu = time_real
1948 #endif
1949       tcpu = 0d0 !el
1950       return
1951       end function tcpu
1952 !-----------------------------------------------------------------------------
1953       subroutine dajczas(rntime,hrtime,mintime,sectime)
1954
1955 !      include 'COMMON.IOUNITS'
1956       integer :: ihr,imn,isc
1957       real(kind=8) :: rntime,hrtime,mintime,sectime
1958       hrtime=rntime/3600.0D0
1959       hrtime=aint(hrtime)
1960       mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
1961       sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
1962       if (sectime.eq.60.0D0) then
1963         sectime=0.0D0
1964         mintime=mintime+1.0D0
1965       endif
1966       ihr=hrtime
1967       imn=mintime
1968       isc=sectime
1969       write (iout,328) ihr,imn,isc
1970   328 FORMAT(//'***** Computation time: ',I4  ,' hours ',I2  ,&
1971                ' minutes ', I2  ,' seconds *****')
1972       return
1973       end subroutine dajczas
1974 !-----------------------------------------------------------------------------
1975       subroutine print_detailed_timing
1976
1977 !      implicit real*8 (a-h,o-z)
1978 !      include 'DIMENSIONS'
1979 #ifdef MPI
1980       include 'mpif.h'
1981 #endif
1982 !      include 'COMMON.IOUNITS'
1983 !      include 'COMMON.TIME1'
1984 !      include 'COMMON.SETUP'
1985       real(kind=8) :: time1,time_barrier
1986       time_barrier = 0.0d0
1987 #ifdef MPI !el
1988       time1=MPI_WTIME()
1989 #endif !el
1990          write (iout,'(80(1h=)/a/(80(1h=)))') &
1991           "Details of FG communication time"
1992          write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') &
1993           "BROADCAST:",time_bcast,"REDUCE:",time_reduce,&
1994           "GATHER:",time_gather,&
1995           "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv,&
1996           "BARRIER ene",time_barrier_e,&
1997           "BARRIER grad",time_barrier_g,&
1998           "TOTAL:",&
1999           time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv
2000          write (*,*) fg_rank,myrank,&
2001            ': Total wall clock time',time1-walltime,' sec'
2002          write (*,*) "Processor",fg_rank,myrank,&
2003            ": BROADCAST time",time_bcast," REDUCE time",&
2004             time_reduce," GATHER time",time_gather," SCATTER time",&
2005             time_scatter,&
2006            " SCATTER fmatmult",time_scatter_fmatmult,&
2007            " SCATTER ginvmult",time_scatter_ginvmult,&
2008            " SCATTER fmat",time_scatter_fmat,&
2009            " SCATTER ginv",time_scatter_ginv,&
2010             " SENDRECV",time_sendrecv,&
2011             " BARRIER ene",time_barrier_e,&
2012             " BARRIER GRAD",time_barrier_g,&
2013             " BCAST7",time_bcast7," BCASTC",time_bcastc,&
2014             " BCASTW",time_bcastw," ALLREDUCE",time_allreduce,&
2015             " TOTAL",&
2016             time_bcast+time_reduce+time_gather+time_scatter+ &
2017             time_sendrecv+time_barrier+time_bcastc
2018 !el#endif
2019          write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc
2020          write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene
2021          write (*,*) "Processor",fg_rank,myrank," intfromcart",&
2022            time_intfcart
2023          write (*,*) "Processor",fg_rank,myrank," vecandderiv",&
2024            time_vec
2025          write (*,*) "Processor",fg_rank,myrank," setmatrices",&
2026            time_mat
2027          write (*,*) "Processor",fg_rank,myrank," ginvmult",&
2028            time_ginvmult
2029          write (*,*) "Processor",fg_rank,myrank," fricmatmult",&
2030            time_fricmatmult
2031          write (*,*) "Processor",fg_rank,myrank," inttocart",&
2032            time_inttocart
2033          write (*,*) "Processor",fg_rank,myrank," sumgradient",&
2034            time_sumgradient
2035          write (*,*) "Processor",fg_rank,myrank," intcartderiv",&
2036            time_intcartderiv
2037          if (fg_rank.eq.0) then
2038            write (*,*) "Processor",fg_rank,myrank," lagrangian",&
2039              time_lagrangian
2040            write (*,*) "Processor",fg_rank,myrank," cartgrad",&
2041              time_cartgrad
2042          endif
2043       return
2044       end subroutine print_detailed_timing
2045 !-----------------------------------------------------------------------------
2046 !-----------------------------------------------------------------------------
2047       end module control