source/unres/io_config.F90

   1       module io_config
   2
   3       use names
   4       use io_units
   5       use io_base
   6       use geometry_data
   7       use geometry
   8       use control_data, only:maxterm_sccor
   9       implicit none
  10 !-----------------------------------------------------------------------------
  11 ! Max. number of residue types and parameters in expressions for
  12 ! virtual-bond angle bending potentials
  13 !      integer,parameter :: maxthetyp=3
  14 !      integer,parameter :: maxthetyp1=maxthetyp+1
  15 !     ,maxtheterm=20,
  16 !     & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4,
  17 !     & mmaxtheterm=maxtheterm)
  18 !-----------------------------------------------------------------------------
  19 ! Max. number of types of dihedral angles & multiplicity of torsional barriers
  20 ! and the number of terms in double torsionals
  21 !      integer,parameter :: maxlor=3,maxtermd_1=8,maxtermd_2=8
  22 !      parameter (maxtor=4,maxterm=10)
  23 !-----------------------------------------------------------------------------
  24 ! Max number of torsional terms in SCCOR
  25 !el      integer,parameter :: maxterm_sccor=6
  26 !-----------------------------------------------------------------------------
  27       character(len=1),dimension(:),allocatable :: secstruc     !(maxres)
  28 !-----------------------------------------------------------------------------
  29 !
  30 !
  31 !-----------------------------------------------------------------------------
  32       contains
  33 #if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
  34 !-----------------------------------------------------------------------------
  35 ! bank.F    io_csa
  36 !-----------------------------------------------------------------------------
  37       subroutine write_rbank(jlee,adif,nft)
  38
  39       use csa_data
  40       use geometry_data, only: nres,rad2deg
  41 !      implicit real*8 (a-h,o-z)
  42 !      include 'DIMENSIONS'
  43 !      include 'COMMON.IOUNITS'
  44 !      include 'COMMON.CSA'
  45 !      include 'COMMON.BANK'
  46 !      include 'COMMON.CHAIN'
  47 !      include 'COMMON.GEO'
  48 !el local variables
  49       integer :: nft,i,k,j,l,jlee
  50       real(kind=8) :: adif
  51
  52       open(icsa_rbank,file=csa_rbank,status="unknown")
  53       write (icsa_rbank,900) jlee,nbank,nstep,nft,icycle,adif
  54       do k=1,nbank
  55        write (icsa_rbank,952) k,rene(k),rrmsn(k),rpncn(k)
  56        do j=1,numch
  57         do l=2,nres-1
  58          write (icsa_rbank,850) (rad2deg*rvar(i,l,j,k),i=1,4)
  59         enddo
  60        enddo
  61       enddo
  62       close(icsa_rbank)
  63
  64   850 format (10f8.3)
  65   900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =",&
  66               i8,i10,i2,f15.5)
  67   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3,&
  68                   ' %NC ',0pf5.2)
  69
  70       return
  71       end subroutine write_rbank
  72 !-----------------------------------------------------------------------------
  73       subroutine read_rbank(jlee,adif)
  74
  75       use csa_data
  76       use geometry_data, only: nres,deg2rad
  77       use MPI_data
  78 !      implicit real*8 (a-h,o-z)
  79 !      include 'DIMENSIONS'
  80       include 'mpif.h'
  81 !      include 'COMMON.IOUNITS'
  82 !      include 'COMMON.CSA'
  83 !      include 'COMMON.BANK'
  84 !      include 'COMMON.CHAIN'
  85 !      include 'COMMON.GEO'
  86 !      include 'COMMON.SETUP'
  87       character(len=80) :: karta
  88 !el local variables
  89       integer :: nbankr,nstepr,nftr,icycler,kk,k,j,l,i,&
  90                  ierror,ierrcode,jlee,jleer
  91       real(kind=8) :: adif
  92
  93       open(icsa_rbank,file=csa_rbank,status="old")
  94       read (icsa_rbank,901) jleer,nbankr,nstepr,nftr,icycler,adif
  95       print *,jleer,nbankr,nstepr,nftr,icycler,adif
  96 !       print *, 'adif from read_rbank ',adif
  97 #ifdef MPI
  98       if(nbankr.ne.nbank) then
  99         write (iout,*) 'ERROR in READ_BANK: NBANKR',nbankr,&
 100         ' NBANK',nbank
 101         call mpi_abort(mpi_comm_world,ierror,ierrcode)
 102       endif
 103       if(jleer.ne.jlee) then
 104         write (iout,*) 'ERROR in READ_BANK: JLEER',jleer,&
 105         ' JLEE',jlee
 106         call mpi_abort(mpi_comm_world,ierror,ierrcode)
 107       endif
 108 #endif
 109
 110       kk=0
 111       do k=1,nbankr
 112         read (icsa_rbank,'(a80)') karta
 113         write(iout,*) "READ_RBANK: kk=",kk
 114         write(iout,*) karta
 115 !        if (index(karta,"*").gt.0) then
 116 !          write (iout,*) "***** Stars in bankr ***** k=",k,
 117 !     &      " skipped"
 118 !          do j=1,numch
 119 !            do l=2,nres-1
 120 !              read (30,850) (rdummy,i=1,4)
 121 !            enddo
 122 !          enddo
 123 !        else
 124           kk=kk+1
 125           call reada(karta,"total E",rene(kk),1.0d20)
 126           call reada(karta,"rmsd from N",rrmsn(kk),0.0d0)
 127           call reada(karta,"%NC",rpncn(kk),0.0d0)
 128           write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk),&
 129             "%NC",bpncn(kk),ibank(kk)
 130 !          read (icsa_rbank,953) kdummy,rene(kk),rrmsn(kk),rpncn(kk)
 131           do j=1,numch
 132             do l=2,nres-1
 133               read (icsa_rbank,850) (rvar(i,l,j,kk),i=1,4)
 134 !              write (iout,850) (rvar(i,l,j,kk),i=1,4)
 135               do i=1,4
 136                 rvar(i,l,j,kk)=deg2rad*rvar(i,l,j,kk)
 137               enddo
 138             enddo
 139           enddo
 140 !        endif
 141       enddo
 142 !d      write (*,*) "read_rbank ******************* kk",kk,
 143 !d     &  "nbankr",nbankr
 144       if (kk.lt.nbankr) nbankr=kk
 145 !d      do kk=1,nbankr
 146 !d          print *,"kk=",kk
 147 !d          do j=1,numch
 148 !d            do l=2,nres-1
 149 !d              write (*,850) (rvar(i,l,j,kk),i=1,4)
 150 !d            enddo
 151 !d          enddo
 152 !d      enddo
 153       close(icsa_rbank)
 154
 155   850 format (10f8.3)
 156   901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5)
 157   953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2)
 158
 159       return
 160       end subroutine read_rbank
 161 !-----------------------------------------------------------------------------
 162       subroutine write_bank(jlee,nft)
 163
 164       use csa_data
 165       use control_data, only: vdisulf
 166       use geometry_data, only: nres,rad2deg
 167 !      implicit real*8 (a-h,o-z)
 168 !      include 'DIMENSIONS'
 169 !      include 'COMMON.IOUNITS'
 170 !      include 'COMMON.CSA'
 171 !      include 'COMMON.BANK'
 172 !      include 'COMMON.CHAIN'
 173 !      include 'COMMON.GEO'
 174 !      include 'COMMON.SBRIDGE'
 175 !     include 'COMMON.CONTROL'
 176       character(len=7) :: chtmp
 177       character(len=40) :: chfrm
 178 !el      external ilen
 179 !el local variables
 180       integer :: nft,k,l,i,j,jlee
 181
 182       open(icsa_bank,file=csa_bank,status="unknown")
 183       write (icsa_bank,900) jlee,nbank,nstep,nft,icycle,cutdif
 184       write (icsa_bank,902) nglob_csa, eglob_csa
 185       open (igeom,file=intname,status='UNKNOWN')
 186       do k=1,nbank
 187        write (icsa_bank,952) k,bene(k),brmsn(k),bpncn(k),ibank(k)
 188        if (vdisulf) write (icsa_bank,'(101i4)') &
 189           bvar_nss(k),((bvar_ss(j,i,k),j=1,2),i=1,bvar_nss(k))
 190        do j=1,numch
 191         do l=2,nres-1
 192          write (icsa_bank,850) (rad2deg*bvar(i,l,j,k),i=1,4)
 193         enddo
 194        enddo
 195        if (bvar_nss(k).le.9) then
 196          write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),&
 197            bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k))
 198        else
 199          write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),&
 200            bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9)
 201          write (igeom,'(3X,11(1X,2I3))') (bvar_ss(1,i,k),&
 202                                       bvar_ss(2,i,k),i=10,bvar_nss(k))
 203        endif
 204        write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1)
 205        write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2)
 206        write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1)
 207        write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1)
 208       enddo
 209       close(icsa_bank)
 210       close(igeom)
 211
 212       if (nstep/200.gt.ilastnstep) then
 213
 214        ilastnstep=(ilastnstep+1)*1.5
 215        write(chfrm,'(a2,i1,a1)') '(i',int(dlog10(dble(nstep))+1),')'
 216        write(chtmp,chfrm) nstep
 217        open(icsa_int,file=prefix(:ilen(prefix)) &
 218                //'_'//chtmp(:ilen(chtmp))//'.int',status='UNKNOWN')
 219        do k=1,nbank
 220         if (bvar_nss(k).le.9) then
 221          write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),&
 222         bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k))
 223         else
 224          write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),&
 225            bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9)
 226          write (icsa_int,'(3X,11(1X,2I3))') (bvar_ss(1,i,k),&
 227                                 bvar_ss(2,i,k),i=10,bvar_nss(k))
 228         endif
 229         write (icsa_int,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1)
 230         write (icsa_int,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2)
 231         write (icsa_int,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1)
 232         write (icsa_int,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1)
 233        enddo
 234        close(icsa_int)
 235       endif
 236
 237
 238   200 format (8f10.4)
 239   850 format (10f8.3)
 240   900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =",&
 241               i8,i10,i2,f15.5)
 242   902 format (1x,'nglob_csa =',i4,' eglob_csa =',1pe14.5)
 243   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3,&
 244               ' %NC ',0pf5.2,i5)
 245
 246       return
 247       end subroutine write_bank
 248 !-----------------------------------------------------------------------------
 249       subroutine write_bank_reminimized(jlee,nft)
 250
 251       use csa_data
 252       use geometry_data, only: nres,rad2deg
 253       use energy_data
 254 !      implicit real*8 (a-h,o-z)
 255 !      include 'DIMENSIONS'
 256 !      include 'COMMON.IOUNITS'
 257 !      include 'COMMON.CSA'
 258 !      include 'COMMON.BANK'
 259 !      include 'COMMON.CHAIN'
 260 !      include 'COMMON.GEO'
 261 !      include 'COMMON.SBRIDGE'
 262 !el local variables
 263       integer :: nft,i,l,j,k,jlee
 264
 265       open(icsa_bank_reminimized,file=csa_bank_reminimized,&
 266         status="unknown")
 267       write (icsa_bank_reminimized,900) &
 268         jlee,nbank,nstep,nft,icycle,cutdif
 269       open (igeom,file=intname,status='UNKNOWN')
 270       do k=1,nbank
 271        write (icsa_bank_reminimized,952) k,bene(k),brmsn(k),&
 272         bpncn(k),ibank(k)
 273        do j=1,numch
 274         do l=2,nres-1
 275          write (icsa_bank_reminimized,850) (rad2deg*bvar(i,l,j,k),i=1,4)
 276         enddo
 277        enddo
 278        if (nss.le.9) then
 279          write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),&
 280            nss,(ihpb(i),jhpb(i),i=1,nss)
 281        else
 282          write (igeom,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),&
 283            nss,(ihpb(i),jhpb(i),i=1,9)
 284          write (igeom,'(3X,11(1X,2I3))') (ihpb(i),jhpb(i),i=10,nss)
 285        endif
 286        write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1)
 287        write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2)
 288        write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1)
 289        write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1)
 290       enddo
 291       close(icsa_bank_reminimized)
 292       close(igeom)
 293
 294   200 format (8f10.4)
 295   850 format (10f8.3)
 296   900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =",&
 297               i8,i10,i2,f15.5)
 298   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3,&
 299                ' %NC ',0pf5.2,i5)
 300
 301       return
 302       end subroutine write_bank_reminimized
 303 !-----------------------------------------------------------------------------
 304       subroutine read_bank(jlee,nft,cutdifr)
 305
 306       use csa_data
 307       use control_data, only: vdisulf
 308       use geometry_data, only: nres,deg2rad
 309       use energy_data
 310 !      implicit real*8 (a-h,o-z)
 311 !      include 'DIMENSIONS'
 312 !      include 'COMMON.IOUNITS'
 313 !      include 'COMMON.CSA'
 314 !      include 'COMMON.BANK'
 315 !      include 'COMMON.CHAIN'
 316 !      include 'COMMON.GEO'
 317 !      include 'COMMON.CONTROL'
 318 !      include 'COMMON.SBRIDGE'
 319       character(len=80) :: karta
 320 !      integer ilen
 321 !el      external ilen
 322 !el local variables
 323       integer :: nft,kk,k,l,i,j,jlee
 324       real(kind=8) :: cutdifr
 325
 326       open(icsa_bank,file=csa_bank,status="old")
 327        read (icsa_bank,901) jlee,nbank,nstep,nft,icycle,cutdifr
 328        read (icsa_bank,902) nglob_csa, eglob_csa
 329 !      if(jleer.ne.jlee) then
 330 !        write (iout,*) 'ERROR in READ_BANK: JLEER',jleer,
 331 !    &   ' JLEE',jlee
 332 !        call mpi_abort(mpi_comm_world,ierror,ierrcode)
 333 !      endif
 334
 335       kk=0
 336       do k=1,nbank
 337         read (icsa_bank,'(a80)') karta
 338         write(iout,*) "READ_BANK: kk=",kk
 339         write(iout,*) karta
 340 !        if (index(karta,"*").gt.0) then
 341 !          write (iout,*) "***** Stars in bank ***** k=",k,
 342 !     &      " skipped"
 343 !          do j=1,numch
 344 !            do l=2,nres-1
 345 !              read (33,850) (rdummy,i=1,4)
 346 !            enddo
 347 !          enddo
 348 !        else
 349           kk=kk+1
 350           call reada(karta,"total E",bene(kk),1.0d20)
 351           call reada(karta,"rmsd from N",brmsn(kk),0.0d0)
 352           call reada(karta,"%NC",bpncn(kk),0.0d0)
 353           read (karta(ilen(karta)-1:),*,end=111,err=111) ibank(kk)
 354           goto 112
 355   111     ibank(kk)=0
 356   112     continue
 357           write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk),&
 358             "%NC",bpncn(kk),ibank(kk)
 359 !          read (icsa_bank,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k)
 360           if (vdisulf) then
 361             read (icsa_bank,'(101i4)') &
 362               bvar_nss(kk),((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk))
 363             bvar_ns(kk)=ns-2*bvar_nss(kk)
 364             write(iout,*) 'read SSBOND',bvar_nss(kk),&
 365                           ((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk))
 366 !d          write(iout,*) 'read CYS #free ', bvar_ns(kk)
 367             l=0
 368             do i=1,ns
 369              j=1
 370              do while( iss(i).ne.bvar_ss(1,j,kk)-nres .and. &
 371                        iss(i).ne.bvar_ss(2,j,kk)-nres .and. &
 372                        j.le.bvar_nss(kk))
 373                 j=j+1
 374              enddo
 375              if (j.gt.bvar_nss(kk)) then
 376                l=l+1
 377                bvar_s(l,kk)=iss(i)
 378              endif
 379             enddo
 380 !d            write(iout,*)'read CYS free',(bvar_s(l,kk),l=1,bvar_ns(kk))
 381           endif
 382           do j=1,numch
 383             do l=2,nres-1
 384               read (icsa_bank,850) (bvar(i,l,j,kk),i=1,4)
 385 !              write (iout,850) (bvar(i,l,j,kk),i=1,4)
 386               do i=1,4
 387                 bvar(i,l,j,kk)=deg2rad*bvar(i,l,j,kk)
 388               enddo ! l
 389             enddo ! l
 390           enddo ! j
 391 !        endif
 392       enddo ! k
 393
 394       if (kk.lt.nbank) nbank=kk
 395 !d      write (*,*) "read_bank ******************* kk",kk,
 396 !d     &  "nbank",nbank
 397 !d      do kk=1,nbank
 398 !d          print *,"kk=",kk
 399 !d          do j=1,numch
 400 !d            do l=2,nres-1
 401 !d              write (*,850) (bvar(i,l,j,kk),i=1,4)
 402 !d            enddo
 403 !d          enddo
 404 !d      enddo
 405
 406 !       do k=1,nbank
 407 !        read (33,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k)
 408 !        do j=1,numch
 409 !         do l=2,nres-1
 410 !          read (33,850) (bvar(i,l,j,k),i=1,4)
 411 !          do i=1,4
 412 !           bvar(i,l,j,k)=deg2rad*bvar(i,l,j,k)
 413 !          enddo
 414 !         enddo
 415 !        enddo
 416 !       enddo
 417       close(icsa_bank)
 418
 419   850 format (10f8.3)
 420   952 format (1x,'#',i4,' total E ',f12.3,' rmsd from N ',f8.3,i5)
 421   901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5)
 422   902 format (1x,11x,i4,12x,1pe14.5)
 423   953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2,i5)
 424
 425       return
 426       end subroutine read_bank
 427 !-----------------------------------------------------------------------------
 428       subroutine write_bank1(jlee)
 429
 430       use csa_data
 431       use geometry_data, only: nres,rad2deg
 432 !      implicit real*8 (a-h,o-z)
 433 !      include 'DIMENSIONS'
 434 !      include 'COMMON.IOUNITS'
 435 !      include 'COMMON.CSA'
 436 !      include 'COMMON.BANK'
 437 !      include 'COMMON.CHAIN'
 438 !      include 'COMMON.GEO'
 439 !el local variables
 440       integer :: k,i,l,j,jlee
 441
 442 #if defined(AIX) || defined(PGI)
 443       open(icsa_bank1,file=csa_bank1,position="append")
 444 #else
 445       open(icsa_bank1,file=csa_bank1,access="append")
 446 #endif
 447       write (icsa_bank1,900) jlee,nbank,nstep,cutdif
 448       do k=1,nbank
 449        write (icsa_bank1,952) k,bene(k),brmsn(k),bpncn(k),ibank(k)
 450        do j=1,numch
 451         do l=2,nres-1
 452          write (icsa_bank1,850) (rad2deg*bvar(i,l,j,k),i=1,4)
 453         enddo
 454        enddo
 455       enddo
 456       close(icsa_bank1)
 457   850 format (10f8.3)
 458   900 format (4x,"jlee =",i5,3x,"nbank =",i5,3x,"nstep =",i10,f15.5)
 459   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3,&
 460               ' %NC ',0pf5.2,i5)
 461
 462       return
 463       end subroutine write_bank1
 464 !-----------------------------------------------------------------------------
 465 ! cartprint.f
 466 !-----------------------------------------------------------------------------
 467 !      subroutine cartprint
 468
 469 !      use geometry_data, only: c
 470 !      use energy_data, only: itype
 471 !      implicit real*8 (a-h,o-z)
 472 !      include 'DIMENSIONS'
 473 !      include 'COMMON.CHAIN'
 474 !      include 'COMMON.INTERACT'
 475 !      include 'COMMON.NAMES'
 476 !      include 'COMMON.IOUNITS'
 477 !      integer :: i
 478
 479 !     write (iout,100)
 480 !      do i=1,nres
 481 !        write (iout,110) restyp(itype(i,1)),i,c(1,i),c(2,i),&
 482 !          c(3,i),c(1,nres+i),c(2,nres+i),c(3,nres+i)
 483 !      enddo
 484 !  100 format (//'              alpha-carbon coordinates       ',&
 485 !                '     centroid coordinates'/ &
 486 !                '       ', 6X,'X',11X,'Y',11X,'Z',&
 487 !                                10X,'X',11X,'Y',11X,'Z')
 488 !  110 format (a,'(',i3,')',6f12.5)
 489 !      return
 490 !      end subroutine cartprint
 491 !-----------------------------------------------------------------------------
 492 ! dihed_cons.F
 493 !-----------------------------------------------------------------------------
 494       subroutine secstrp2dihc
 495
 496       use geometry_data
 497       use energy_data
 498 !      implicit real*8 (a-h,o-z)
 499 !      include 'DIMENSIONS'
 500 !      include 'COMMON.GEO'
 501 !      include 'COMMON.BOUNDS'
 502 !      include 'COMMON.CHAIN'
 503 !      include 'COMMON.TORCNSTR'
 504 !      include 'COMMON.IOUNITS'
 505 !el      character(len=1),dimension(nres) :: secstruc   !(maxres)
 506 !el      COMMON/SECONDARYS/secstruc
 507       character(len=80) :: line
 508       logical :: errflag
 509 !el      external ilen
 510
 511 !el  local variables
 512       integer :: i,ii,lenpre
 513
 514       allocate(secstruc(nres))
 515
 516 !dr      call getenv_loc('SECPREDFIL',secpred)
 517       lenpre=ilen(prefix)
 518       secpred=prefix(:lenpre)//'.spred'
 519
 520 #if defined(WINIFL) || defined(WINPGI)
 521       open(isecpred,file=secpred,status='old',readonly,shared)
 522 #elif (defined CRAY) || (defined AIX)
 523       open(isecpred,file=secpred,status='old',action='read')
 524 #elif (defined G77)
 525       open(isecpred,file=secpred,status='old')
 526 #else
 527       open(isecpred,file=secpred,status='old',action='read')
 528 #endif
 529 ! read secondary structure prediction from JPRED here!
 530 !      read(isecpred,'(A80)',err=100,end=100) line
 531 !      read(line,'(f10.3)',err=110) ftors
 532        read(isecpred,'(f10.3)',err=110) ftors(1)
 533
 534       write (iout,*) 'FTORS factor =',ftors(1)
 535 ! initialize secstruc to any
 536        do i=1,nres
 537         secstruc(i) ='-'
 538       enddo
 539       ndih_constr=0
 540       ndih_nconstr=0
 541
 542       call read_secstr_pred(isecpred,iout,errflag)
 543       if (errflag) then
 544          write(iout,*)'There is a problem with the list of secondary-',&
 545            'structure prediction'
 546          goto 100
 547       endif
 548 ! 8/13/98 Set limits to generating the dihedral angles
 549       do i=1,nres
 550         phibound(1,i)=-pi
 551         phibound(2,i)=pi
 552       enddo
 553
 554       ii=0
 555       do i=1,nres
 556          ftors(i)=ftors(1)
 557         if ( secstruc(i) .eq. 'H') then
 558 ! Helix restraints for this residue
 559            ii=ii+1
 560            idih_constr(ii)=i
 561            phi0(ii) = 45.0D0*deg2rad
 562            drange(ii)= 5.0D0*deg2rad
 563            phibound(1,i) = phi0(ii)-drange(ii)
 564            phibound(2,i) = phi0(ii)+drange(ii)
 565         else if (secstruc(i) .eq. 'E') then
 566 ! strand restraints for this residue
 567            ii=ii+1
 568            idih_constr(ii)=i
 569            phi0(ii) = 180.0D0*deg2rad
 570            drange(ii)= 5.0D0*deg2rad
 571            phibound(1,i) = phi0(ii)-drange(ii)
 572            phibound(2,i) = phi0(ii)+drange(ii)
 573         else
 574 ! no restraints for this residue
 575            ndih_nconstr=ndih_nconstr+1
 576            idih_nconstr(ndih_nconstr)=i
 577         endif
 578       enddo
 579       ndih_constr=ii
 580 !      deallocate(secstruc)
 581       return
 582 100   continue
 583       write(iout,'(A30,A80)')'Error reading file SECPRED',secpred
 584 !      deallocate(secstruc)
 585       return
 586 110   continue
 587       write(iout,'(A20)')'Error reading FTORS'
 588 !      deallocate(secstruc)
 589       return
 590       end subroutine secstrp2dihc
 591 !-----------------------------------------------------------------------------
 592       subroutine read_secstr_pred(jin,jout,errors)
 593
 594 !      implicit real*8 (a-h,o-z)
 595 !      INCLUDE 'DIMENSIONS'
 596 !      include 'COMMON.IOUNITS'
 597 !      include 'COMMON.CHAIN'
 598 !el      character(len=1),dimension(nres) :: secstruc   !(maxres)
 599 !el      COMMON/SECONDARYS/secstruc
 600 !el      EXTERNAL ILEN
 601       character(len=80) :: line,line1   !,ucase
 602       logical :: errflag,errors,blankline
 603
 604 !el  local variables
 605       integer :: jin,jout,iseq,ipos,ipos1,iend,il,&
 606             length_of_chain
 607       errors=.false.
 608       read (jin,'(a)') line
 609       write (jout,'(2a)') '> ',line(1:78)
 610       line1=ucase(line)
 611 ! Remember that we number full residues starting from 2, then, iseq=1 and iseq=nres
 612 ! correspond to the end-groups.  ADD to the secondary structure prediction "-" for the
 613 ! end-groups in the input file "*.spred"
 614
 615       iseq=1
 616       do while (index(line1,'$END').eq.0)
 617 ! Override commented lines.
 618          ipos=1
 619          blankline=.false.
 620          do while (.not.blankline)
 621             line1=' '
 622             call mykey(line,line1,ipos,blankline,errflag)
 623             if (errflag) write (jout,'(2a)') &
 624        'Error when reading sequence in line: ',line
 625             errors=errors .or. errflag
 626             if (.not. blankline .and. .not. errflag) then
 627                ipos1=2
 628                iend=ilen(line1)
 629 !el               if (iseq.le.maxres) then
 630                   if (line1(1:1).eq.'-' ) then
 631                      secstruc(iseq)=line1(1:1)
 632                   else if ( ( ucase(line1(1:1)).eq.'E' ) .or. &
 633                             ( ucase(line1(1:1)).eq.'H' ) ) then
 634                      secstruc(iseq)=ucase(line1(1:1))
 635                   else
 636                      errors=.true.
 637                      write (jout,1010) line1(1:1), iseq
 638                      goto 80
 639                   endif
 640 !el               else
 641 !el                  errors=.true.
 642 !el                  write (jout,1000) iseq,maxres
 643 !el                  goto 80
 644 !el               endif
 645                do while (ipos1.le.iend)
 646
 647                   iseq=iseq+1
 648                   il=1
 649                   ipos1=ipos1+1
 650 !el                  if (iseq.le.maxres) then
 651                      if (line1(ipos1-1:ipos1-1).eq.'-' ) then
 652                         secstruc(iseq)=line1(ipos1-1:ipos1-1)
 653                      else if((ucase(line1(ipos1-1:ipos1-1)).eq.'E').or. &
 654                            (ucase(line1(ipos1-1:ipos1-1)).eq.'H') ) then
 655                         secstruc(iseq)=ucase(line1(ipos1-1:ipos1-1))
 656                      else
 657                         errors=.true.
 658                         write (jout,1010) line1(ipos1-1:ipos1-1), iseq
 659                         goto 80
 660                      endif
 661 !el                  else
 662 !el                     errors=.true.
 663 !el                     write (jout,1000) iseq,maxres
 664 !el                     goto 80
 665 !el                  endif
 666                enddo
 667                iseq=iseq+1
 668             endif
 669          enddo
 670          read (jin,'(a)') line
 671          write (jout,'(2a)') '> ',line(1:78)
 672          line1=ucase(line)
 673       enddo
 674
 675 !d    write (jout,'(10a8)') (sequence(i),i=1,iseq-1)
 676
 677 !d check whether the found length of the chain is correct.
 678       length_of_chain=iseq-1
 679       if (length_of_chain .ne. nres) then
 680 !        errors=.true.
 681         write (jout,'(a,i4,a,i4,a)') &
 682        'Error: the number of labels specified in $SEC_STRUC_PRED (' &
 683        ,length_of_chain,') does not match with the number of residues (' &
 684        ,nres,').'
 685       endif
 686    80 continue
 687
 688  1000 format('Error - the number of residues (',i4,&
 689        ') has exceeded maximum (',i4,').')
 690  1010 format ('Error - unrecognized secondary structure label',a4,&
 691        ' in position',i4)
 692       return
 693       end subroutine read_secstr_pred
 694 !#endif
 695 !-----------------------------------------------------------------------------
 696 ! parmread.F
 697 !-----------------------------------------------------------------------------
 698       subroutine parmread
 699
 700       use geometry_data
 701       use energy_data
 702       use control_data, only:maxterm !,maxtor
 703       use MD_data
 704       use MPI_data
 705 !el      use map_data
 706       use control, only: getenv_loc
 707 !
 708 ! Read the parameters of the probability distributions of the virtual-bond
 709 ! valence angles and the side chains and energy parameters.
 710 !
 711 ! Important! Energy-term weights ARE NOT read here; they are read from the
 712 ! main input file instead, because NO defaults have yet been set for these
 713 ! parameters.
 714 !
 715 !      implicit real*8 (a-h,o-z)
 716 !      include 'DIMENSIONS'
 717 #ifdef MPI
 718       include "mpif.h"
 719       integer :: IERROR
 720 #endif
 721 !      include 'COMMON.IOUNITS'
 722 !      include 'COMMON.CHAIN'
 723 !      include 'COMMON.INTERACT'
 724 !      include 'COMMON.GEO'
 725 !      include 'COMMON.LOCAL'
 726 !      include 'COMMON.TORSION'
 727 !      include 'COMMON.SCCOR'
 728 !      include 'COMMON.SCROT'
 729 !      include 'COMMON.FFIELD'
 730 !      include 'COMMON.NAMES'
 731 !      include 'COMMON.SBRIDGE'
 732 !      include 'COMMON.MD'
 733 !      include 'COMMON.SETUP'
 734       character(len=1) :: t1,t2,t3
 735       character(len=1) :: onelett(4) = (/"G","A","P","D"/)
 736       character(len=1) :: toronelet(-2:2) = (/"p","a","G","A","P"/)
 737       logical :: lprint,LaTeX,SPLIT_FOURIERTOR
 738       real(kind=8),dimension(3,3,maxlob) :: blower      !(3,3,maxlob)
 739       real(kind=8),dimension(13) :: buse
 740       character(len=3) :: lancuch       !,ucase
 741 !el  local variables
 742       integer :: m,n,l,i,j,k,iblock,lll,llll,ll,nlobi,mm,jj
 743       integer :: maxinter,junk,kk,ii,ncatprotparm,nkcctyp
 744       real(kind=8) :: v0ijsccor,v0ijsccor1,v0ijsccor2,v0ijsccor3,si,&
 745                 dwa16,rjunk,akl,v0ij,rri,epsij,rrij,sigeps,sigt1sq,&
 746                 sigt2sq,sigii1,sigii2,ratsig1,ratsig2,rsum_max,r_augm,&
 747                 res1,epsijlip,epspeptube,epssctube,sigmapeptube,      &
 748                 sigmasctube
 749       integer :: ichir1,ichir2,ijunk
 750       character*3 string
 751
 752 !      real(kind=8),dimension(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) :: v1_el,v2_el !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)
 753 !el      allocate(v1_el(maxterm,-maxtor:maxtor,-maxtor:maxtor,2))
 754 !el      allocate(v2_el(maxterm,-maxtor:maxtor,-maxtor:maxtor,2))
 755 !
 756 ! For printing parameters after they are read set the following in the UNRES
 757 ! C-shell script:
 758 !
 759 ! setenv PRINT_PARM YES
 760 !
 761 ! To print parameters in LaTeX format rather than as ASCII tables:
 762 !
 763 ! setenv LATEX YES
 764 !
 765       call getenv_loc("PRINT_PARM",lancuch)
 766       lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y")
 767       call getenv_loc("LATEX",lancuch)
 768       LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y")
 769 !
 770       dwa16=2.0d0**(1.0d0/6.0d0)
 771       itypro=20
 772 ! Assign virtual-bond length
 773       vbl=3.8D0
 774       vblinv=1.0D0/vbl
 775       vblinv2=vblinv*vblinv
 776 !
 777 ! Read the virtual-bond parameters, masses, and moments of inertia
 778 ! and Stokes' radii of the peptide group and side chains
 779 !
 780       allocate(dsc(ntyp1)) !(ntyp1)
 781       allocate(dsc_inv(ntyp1)) !(ntyp1)
 782       allocate(nbondterm_nucl(ntyp_molec(2))) !(ntyp)
 783       allocate(vbldsc0_nucl(maxbondterm,ntyp_molec(2))) !(maxbondterm,ntyp)
 784       allocate(aksc_nucl(maxbondterm,ntyp_molec(2))) !(maxbondterm,ntyp)
 785       allocate(nbondterm(ntyp)) !(ntyp)
 786       allocate(vbldsc0(maxbondterm,ntyp)) !(maxbondterm,ntyp)
 787       allocate(aksc(maxbondterm,ntyp)) !(maxbondterm,ntyp)
 788       allocate(abond0(maxbondterm,ntyp)) !(maxbondterm,ntyp)
 789       allocate(long_r_sidechain(ntyp))
 790       allocate(short_r_sidechain(ntyp))
 791       dsc(:)=0.0d0
 792       dsc_inv(:)=0.0d0
 793
 794 #ifdef CRYST_BOND
 795       allocate(msc(ntyp+1)) !(ntyp+1)
 796       allocate(isc(ntyp+1)) !(ntyp+1)
 797       allocate(restok(ntyp+1)) !(ntyp+1)
 798
 799       read (ibond,*) vbldp0,akp,mp,ip,pstok
 800       do i=1,ntyp
 801         nbondterm(i)=1
 802         read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i)
 803         dsc(i) = vbldsc0(1,i)
 804         if (i.eq.10) then
 805           dsc_inv(i)=0.0D0
 806         else
 807           dsc_inv(i)=1.0D0/dsc(i)
 808         endif
 809       enddo
 810 #else
 811       mp(:)=0.0d0
 812       ip(:)=0.0d0
 813       msc(:,:)=0.0d0
 814       isc(:,:)=0.0d0
 815
 816       allocate(msc(ntyp+1,5)) !(ntyp+1)
 817       allocate(isc(ntyp+1,5)) !(ntyp+1)
 818       allocate(restok(ntyp+1,5)) !(ntyp+1)
 819
 820       read (ibond,*) junk,vbldp0,vbldpDUM,akp,rjunk,mp(1),ip(1),pstok(1)
 821       do i=1,ntyp_molec(1)
 822         read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),&
 823          j=1,nbondterm(i)),msc(i,1),isc(i,1),restok(i,1)
 824         dsc(i) = vbldsc0(1,i)
 825         if (i.eq.10) then
 826           dsc_inv(i)=0.0D0
 827         else
 828           dsc_inv(i)=1.0D0/dsc(i)
 829         endif
 830       enddo
 831 #endif
 832       read (ibond_nucl,*) vbldp0_nucl,akp_nucl,mp(2),ip(2),pstok(2)
 833       do i=1,ntyp_molec(2)
 834         nbondterm_nucl(i)=1
 835         read (ibond_nucl,*) vbldsc0_nucl(1,i),aksc_nucl(1,i),msc(i,2),isc(i,2),restok(i,2)
 836 !        dsc(i) = vbldsc0_nucl(1,i)
 837 !        if (i.eq.10) then
 838 !          dsc_inv(i)=0.0D0
 839 !        else
 840 !          dsc_inv(i)=1.0D0/dsc(i)
 841 !        endif
 842       enddo
 843 !      read (ibond_nucl,*) junk,vbldp0_nucl,akp_nucl,rjunk,mp(2),ip(2),pstok(2)
 844 !      do i=1,ntyp_molec(2)
 845 !        read (ibond_nucl,*) nbondterm_nucl(i),(vbldsc0_nucl(j,i),&
 846 !        aksc_nucl(j,i),abond0_nucl(j,i),&
 847 !         j=1,nbondterm_nucl(i)),msc(i,2),isc(i,2),restok(i,2)
 848 !        dsc(i) = vbldsc0(1,i)
 849 !        if (i.eq.10) then
 850 !          dsc_inv(i)=0.0D0
 851 !        else
 852 !          dsc_inv(i)=1.0D0/dsc(i)
 853 !        endif
 854 !      enddo
 855
 856       if (lprint) then
 857         write(iout,'(/a/)')"Dynamic constants of the interaction sites:"
 858         write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass',&
 859          'inertia','Pstok'
 860         write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp(1),ip(1),pstok(1)
 861         do i=1,ntyp
 862           write (iout,'(a10,i3,6f10.5)') restyp(i,1),nbondterm(i),&
 863             vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i,1),isc(i,1),restok(i,1)
 864           do j=2,nbondterm(i)
 865             write (iout,'(13x,3f10.5)') &
 866               vbldsc0(j,i),aksc(j,i),abond0(j,i)
 867           enddo
 868         enddo
 869       endif
 870        if (oldion.eq.1) then
 871             do i=1,ntyp_molec(5)
 872              read(iion,*) msc(i,5),restok(i,5)
 873              print *,msc(i,5),restok(i,5)
 874             enddo
 875             ip(5)=0.2
 876 !            isc(5)=0.2
 877             read (iion,*) ncatprotparm
 878             allocate(catprm(ncatprotparm,4))
 879             do k=1,4
 880             read (iion,*)  (catprm(i,k),i=1,ncatprotparm)
 881             enddo
 882             print *, catprm
 883          endif
 884 !            read (iion,*) (vcatprm(k),k=1,ncatprotpram)
 885 !----------------------------------------------------
 886       allocate(a0thet(-ntyp:ntyp),theta0(-ntyp:ntyp))
 887       allocate(sig0(-ntyp:ntyp),sigc0(-ntyp:ntyp))      !(-ntyp:ntyp)
 888       allocate(athet(2,-ntyp:ntyp,-1:1,-1:1))
 889       allocate(bthet(2,-ntyp:ntyp,-1:1,-1:1)) !(2,-ntyp:ntyp,-1:1,-1:1)
 890       allocate(polthet(0:3,-ntyp:ntyp)) !(0:3,-ntyp:ntyp)
 891       allocate(gthet(3,-ntyp:ntyp))     !(3,-ntyp:ntyp)
 892
 893       a0thet(:)=0.0D0
 894       athet(:,:,:,:)=0.0D0
 895       bthet(:,:,:,:)=0.0D0
 896       polthet(:,:)=0.0D0
 897       gthet(:,:)=0.0D0
 898       theta0(:)=0.0D0
 899       sig0(:)=0.0D0
 900       sigc0(:)=0.0D0
 901       allocate(liptranene(ntyp))
 902 !C reading lipid parameters
 903       write (iout,*) "iliptranpar",iliptranpar
 904       call flush(iout)
 905        read(iliptranpar,*) pepliptran
 906        print *,pepliptran
 907        do i=1,ntyp
 908        read(iliptranpar,*) liptranene(i)
 909         print *,liptranene(i)
 910        enddo
 911        close(iliptranpar)
 912
 913 #ifdef CRYST_THETA
 914 !
 915 ! Read the parameters of the probability distribution/energy expression
 916 ! of the virtual-bond valence angles theta
 917 !
 918       do i=1,ntyp
 919         read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i,1,1),j=1,2),&
 920           (bthet(j,i,1,1),j=1,2)
 921         read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3)
 922         read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3)
 923         read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
 924         sigc0(i)=sigc0(i)**2
 925       enddo
 926       do i=1,ntyp
 927       athet(1,i,1,-1)=athet(1,i,1,1)
 928       athet(2,i,1,-1)=athet(2,i,1,1)
 929       bthet(1,i,1,-1)=-bthet(1,i,1,1)
 930       bthet(2,i,1,-1)=-bthet(2,i,1,1)
 931       athet(1,i,-1,1)=-athet(1,i,1,1)
 932       athet(2,i,-1,1)=-athet(2,i,1,1)
 933       bthet(1,i,-1,1)=bthet(1,i,1,1)
 934       bthet(2,i,-1,1)=bthet(2,i,1,1)
 935       enddo
 936       do i=-ntyp,-1
 937       a0thet(i)=a0thet(-i)
 938       athet(1,i,-1,-1)=athet(1,-i,1,1)
 939       athet(2,i,-1,-1)=-athet(2,-i,1,1)
 940       bthet(1,i,-1,-1)=bthet(1,-i,1,1)
 941       bthet(2,i,-1,-1)=-bthet(2,-i,1,1)
 942       athet(1,i,-1,1)=athet(1,-i,1,1)
 943       athet(2,i,-1,1)=-athet(2,-i,1,1)
 944       bthet(1,i,-1,1)=-bthet(1,-i,1,1)
 945       bthet(2,i,-1,1)=bthet(2,-i,1,1)
 946       athet(1,i,1,-1)=-athet(1,-i,1,1)
 947       athet(2,i,1,-1)=athet(2,-i,1,1)
 948       bthet(1,i,1,-1)=bthet(1,-i,1,1)
 949       bthet(2,i,1,-1)=-bthet(2,-i,1,1)
 950       theta0(i)=theta0(-i)
 951       sig0(i)=sig0(-i)
 952       sigc0(i)=sigc0(-i)
 953        do j=0,3
 954         polthet(j,i)=polthet(j,-i)
 955        enddo
 956        do j=1,3
 957          gthet(j,i)=gthet(j,-i)
 958        enddo
 959       enddo
 960
 961       close (ithep)
 962       if (lprint) then
 963       if (.not.LaTeX) then
 964         write (iout,'(a)') &
 965           'Parameters of the virtual-bond valence angles:'
 966         write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:',&
 967        '    ATHETA0   ','         A1   ','        A2    ',&
 968        '        B1    ','         B2   '
 969         do i=1,ntyp
 970           write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i,1),i,&
 971               a0thet(i),(athet(j,i,1,1),j=1,2),(bthet(j,i,1,1),j=1,2)
 972         enddo
 973         write (iout,'(/a/9x,5a/79(1h-))') &
 974        'Parameters of the expression for sigma(theta_c):',&
 975        '     ALPH0    ','      ALPH1   ','     ALPH2    ',&
 976        '     ALPH3    ','    SIGMA0C   '
 977         do i=1,ntyp
 978           write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i,1),i,&
 979             (polthet(j,i),j=0,3),sigc0(i)
 980         enddo
 981         write (iout,'(/a/9x,5a/79(1h-))') &
 982        'Parameters of the second gaussian:',&
 983        '    THETA0    ','     SIGMA0   ','        G1    ',&
 984        '        G2    ','         G3   '
 985         do i=1,ntyp
 986           write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i,1),i,theta0(i),&
 987              sig0(i),(gthet(j,i),j=1,3)
 988         enddo
 989        else
 990         write (iout,'(a)') &
 991           'Parameters of the virtual-bond valence angles:'
 992         write (iout,'(/a/9x,5a/79(1h-))') &
 993        'Coefficients of expansion',&
 994        '     theta0   ','    a1*10^2   ','   a2*10^2    ',&
 995        '   b1*10^1    ','    b2*10^1   '
 996         do i=1,ntyp
 997           write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i,1),&
 998               a0thet(i),(100*athet(j,i,1,1),j=1,2),&
 999               (10*bthet(j,i,1,1),j=1,2)
1000         enddo
1001         write (iout,'(/a/9x,5a/79(1h-))') &
1002        'Parameters of the expression for sigma(theta_c):',&
1003        ' alpha0       ','  alph1       ',' alph2        ',&
1004        ' alhp3        ','   sigma0c    '
1005         do i=1,ntyp
1006           write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i,1),&
1007             (polthet(j,i),j=0,3),sigc0(i)
1008         enddo
1009         write (iout,'(/a/9x,5a/79(1h-))') &
1010        'Parameters of the second gaussian:',&
1011        '    theta0    ','  sigma0*10^2 ','      G1*10^-1',&
1012        '        G2    ','   G3*10^1    '
1013         do i=1,ntyp
1014           write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i,1),theta0(i),&
1015              100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0
1016         enddo
1017       endif
1018       endif
1019 #else
1020 !
1021 ! Read the parameters of Utheta determined from ab initio surfaces
1022 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
1023 !
1024       IF (tor_mode.eq.0) THEN
1025       read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2,&
1026         ntheterm3,nsingle,ndouble
1027       nntheterm=max0(ntheterm,ntheterm2,ntheterm3)
1028
1029 !----------------------------------------------------
1030       allocate(ithetyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1)
1031       allocate(aa0thet(-nthetyp-1:nthetyp+1,&
1032         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1033 !(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
1034       allocate(aathet(ntheterm,-nthetyp-1:nthetyp+1,&
1035         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1036 !(maxtheterm,-maxthetyp1:maxthetyp1,&
1037 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
1038       allocate(bbthet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
1039         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1040       allocate(ccthet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
1041         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1042       allocate(ddthet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
1043         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1044       allocate(eethet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
1045         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1046 !(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
1047 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
1048       allocate(ffthet(ndouble,ndouble,ntheterm3,-nthetyp-1:nthetyp+1,&
1049         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1050       allocate(ggthet(ndouble,ndouble,ntheterm3,-nthetyp-1:nthetyp+1,&
1051         -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
1052 !(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,&
1053 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
1054
1055       read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1)
1056       do i=-ntyp1,-1
1057         ithetyp(i)=-ithetyp(-i)
1058       enddo
1059
1060       aa0thet(:,:,:,:)=0.0d0
1061       aathet(:,:,:,:,:)=0.0d0
1062       bbthet(:,:,:,:,:,:)=0.0d0
1063       ccthet(:,:,:,:,:,:)=0.0d0
1064       ddthet(:,:,:,:,:,:)=0.0d0
1065       eethet(:,:,:,:,:,:)=0.0d0
1066       ffthet(:,:,:,:,:,:,:)=0.0d0
1067       ggthet(:,:,:,:,:,:,:)=0.0d0
1068
1069 ! VAR:iblock means terminally blocking group 1=non-proline 2=proline
1070       do iblock=1,2
1071 ! VAR:ntethtyp is type of theta potentials type currently 0=glycine
1072 ! VAR:1=non-glicyne non-proline 2=proline
1073 ! VAR:negative values for D-aminoacid
1074       do i=0,nthetyp
1075         do j=-nthetyp,nthetyp
1076           do k=-nthetyp,nthetyp
1077             read (ithep,'(6a)',end=111,err=111) res1
1078             read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock)
1079 ! VAR: aa0thet is variable describing the average value of Foureir
1080 ! VAR: expansion series
1081 ! VAR: aathet is foureir expansion in theta/2 angle for full formula
1082 ! VAR: look at the fitting equation in Kozlowska et al., J. Phys.:
1083 !ondens. Matter 19 (2007) 285203 and Sieradzan et al., unpublished
1084             read (ithep,*,end=111,err=111) &
1085               (aathet(l,i,j,k,iblock),l=1,ntheterm)
1086             read (ithep,*,end=111,err=111) &
1087              ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle),&
1088               (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle),&
1089               (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle),&
1090               (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle),&
1091               ll=1,ntheterm2)
1092             read (ithep,*,end=111,err=111) &
1093             (((ffthet(llll,lll,ll,i,j,k,iblock),&
1094                ffthet(lll,llll,ll,i,j,k,iblock),&
1095                ggthet(llll,lll,ll,i,j,k,iblock),&
1096                ggthet(lll,llll,ll,i,j,k,iblock),&
1097                llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3)
1098           enddo
1099         enddo
1100       enddo
1101 !
1102 ! For dummy ends assign glycine-type coefficients of theta-only terms; the
1103 ! coefficients of theta-and-gamma-dependent terms are zero.
1104 ! IF YOU WANT VALENCE POTENTIALS FOR DUMMY ATOM UNCOMENT BELOW (NOT
1105 ! RECOMENTDED AFTER VERSION 3.3)
1106 !      do i=1,nthetyp
1107 !        do j=1,nthetyp
1108 !          do l=1,ntheterm
1109 !            aathet(l,i,j,nthetyp+1,iblock)=aathet(l,i,j,1,iblock)
1110 !            aathet(l,nthetyp+1,i,j,iblock)=aathet(l,1,i,j,iblock)
1111 !          enddo
1112 !          aa0thet(i,j,nthetyp+1,iblock)=aa0thet(i,j,1,iblock)
1113 !          aa0thet(nthetyp+1,i,j,iblock)=aa0thet(1,i,j,iblock)
1114 !        enddo
1115 !        do l=1,ntheterm
1116 !          aathet(l,nthetyp+1,i,nthetyp+1,iblock)=aathet(l,1,i,1,iblock)
1117 !        enddo
1118 !        aa0thet(nthetyp+1,i,nthetyp+1,iblock)=aa0thet(1,i,1,iblock)
1119 !      enddo
1120 !      enddo
1121 ! AND COMMENT THE LOOPS BELOW
1122       do i=1,nthetyp
1123         do j=1,nthetyp
1124           do l=1,ntheterm
1125             aathet(l,i,j,nthetyp+1,iblock)=0.0d0
1126             aathet(l,nthetyp+1,i,j,iblock)=0.0d0
1127           enddo
1128           aa0thet(i,j,nthetyp+1,iblock)=0.0d0
1129           aa0thet(nthetyp+1,i,j,iblock)=0.0d0
1130         enddo
1131         do l=1,ntheterm
1132           aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0
1133         enddo
1134         aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0
1135       enddo
1136       enddo       !iblock
1137
1138 ! TILL HERE
1139 ! Substitution for D aminoacids from symmetry.
1140       do iblock=1,2
1141       do i=-nthetyp,0
1142         do j=-nthetyp,nthetyp
1143           do k=-nthetyp,nthetyp
1144            aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock)
1145            do l=1,ntheterm
1146            aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock)
1147            enddo
1148            do ll=1,ntheterm2
1149             do lll=1,nsingle
1150             bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock)
1151             ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock)
1152             ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock)
1153             eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock)
1154             enddo
1155           enddo
1156           do ll=1,ntheterm3
1157            do lll=2,ndouble
1158             do llll=1,lll-1
1159             ffthet(llll,lll,ll,i,j,k,iblock)= &
1160             ffthet(llll,lll,ll,-i,-j,-k,iblock)
1161             ffthet(lll,llll,ll,i,j,k,iblock)= &
1162             ffthet(lll,llll,ll,-i,-j,-k,iblock)
1163             ggthet(llll,lll,ll,i,j,k,iblock)= &
1164             -ggthet(llll,lll,ll,-i,-j,-k,iblock)
1165             ggthet(lll,llll,ll,i,j,k,iblock)= &
1166             -ggthet(lll,llll,ll,-i,-j,-k,iblock)
1167             enddo !ll
1168            enddo  !lll
1169           enddo   !llll
1170          enddo    !k
1171         enddo     !j
1172        enddo      !i
1173       enddo       !iblock
1174 !
1175 ! Control printout of the coefficients of virtual-bond-angle potentials
1176 !
1177       if (lprint) then
1178         write (iout,'(//a)') 'Parameter of virtual-bond-angle potential'
1179         do iblock=1,2
1180         do i=1,nthetyp+1
1181           do j=1,nthetyp+1
1182             do k=1,nthetyp+1
1183               write (iout,'(//4a)') &
1184                'Type ',onelett(i),onelett(j),onelett(k)
1185               write (iout,'(//a,10x,a)') " l","a[l]"
1186               write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock)
1187               write (iout,'(i2,1pe15.5)') &
1188                  (l,aathet(l,i,j,k,iblock),l=1,ntheterm)
1189             do l=1,ntheterm2
1190               write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') &
1191                 "b",l,"c",l,"d",l,"e",l
1192               do m=1,nsingle
1193                 write (iout,'(i2,4(1pe15.5))') m,&
1194                 bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock),&
1195                 ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock)
1196               enddo
1197             enddo
1198             do l=1,ntheterm3
1199               write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') &
1200                 "f+",l,"f-",l,"g+",l,"g-",l
1201               do m=2,ndouble
1202                 do n=1,m-1
1203                   write (iout,'(i1,1x,i1,4(1pe15.5))') n,m,&
1204                     ffthet(n,m,l,i,j,k,iblock),&
1205                     ffthet(m,n,l,i,j,k,iblock),&
1206                     ggthet(n,m,l,i,j,k,iblock),&
1207                     ggthet(m,n,l,i,j,k,iblock)
1208                 enddo   !n
1209               enddo     !m
1210             enddo       !l
1211           enddo         !k
1212         enddo           !j
1213       enddo             !i
1214       enddo
1215       call flush(iout)
1216       endif
1217       ELSE
1218 !C here will be the apropriate recalibrating for D-aminoacid
1219       read (ithep,*,end=121,err=121) nthetyp
1220       allocate(nbend_kcc_Tb(-nthetyp:nthetyp))
1221       allocate(v1bend_chyb(0:36,-nthetyp:nthetyp))
1222       do i=-nthetyp+1,nthetyp-1
1223         read (ithep,*,end=121,err=121) nbend_kcc_Tb(i)
1224         do j=0,nbend_kcc_Tb(i)
1225           read (ithep,*,end=121,err=121) ijunk,v1bend_chyb(j,i)
1226         enddo
1227       enddo
1228       if (lprint) then
1229         write (iout,'(a)') &
1230          "Parameters of the valence-only potentials"
1231         do i=-nthetyp+1,nthetyp-1
1232         write (iout,'(2a)') "Type ",toronelet(i)
1233         do k=0,nbend_kcc_Tb(i)
1234           write(iout,'(i5,f15.5)') k,v1bend_chyb(k,i)
1235         enddo
1236         enddo
1237       endif
1238       ENDIF ! TOR_MODE
1239
1240       write (2,*) "Start reading THETA_PDB",ithep_pdb
1241       do i=1,ntyp
1242 !      write (2,*) 'i=',i
1243         read (ithep_pdb,*,err=111,end=111) &
1244            a0thet(i),(athet(j,i,1,1),j=1,2),&
1245           (bthet(j,i,1,1),j=1,2)
1246         read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3)
1247         read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3)
1248         read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
1249         sigc0(i)=sigc0(i)**2
1250       enddo
1251       do i=1,ntyp
1252       athet(1,i,1,-1)=athet(1,i,1,1)
1253       athet(2,i,1,-1)=athet(2,i,1,1)
1254       bthet(1,i,1,-1)=-bthet(1,i,1,1)
1255       bthet(2,i,1,-1)=-bthet(2,i,1,1)
1256       athet(1,i,-1,1)=-athet(1,i,1,1)
1257       athet(2,i,-1,1)=-athet(2,i,1,1)
1258       bthet(1,i,-1,1)=bthet(1,i,1,1)
1259       bthet(2,i,-1,1)=bthet(2,i,1,1)
1260       enddo
1261       do i=-ntyp,-1
1262       a0thet(i)=a0thet(-i)
1263       athet(1,i,-1,-1)=athet(1,-i,1,1)
1264       athet(2,i,-1,-1)=-athet(2,-i,1,1)
1265       bthet(1,i,-1,-1)=bthet(1,-i,1,1)
1266       bthet(2,i,-1,-1)=-bthet(2,-i,1,1)
1267       athet(1,i,-1,1)=athet(1,-i,1,1)
1268       athet(2,i,-1,1)=-athet(2,-i,1,1)
1269       bthet(1,i,-1,1)=-bthet(1,-i,1,1)
1270       bthet(2,i,-1,1)=bthet(2,-i,1,1)
1271       athet(1,i,1,-1)=-athet(1,-i,1,1)
1272       athet(2,i,1,-1)=athet(2,-i,1,1)
1273       bthet(1,i,1,-1)=bthet(1,-i,1,1)
1274       bthet(2,i,1,-1)=-bthet(2,-i,1,1)
1275       theta0(i)=theta0(-i)
1276       sig0(i)=sig0(-i)
1277       sigc0(i)=sigc0(-i)
1278        do j=0,3
1279         polthet(j,i)=polthet(j,-i)
1280        enddo
1281        do j=1,3
1282          gthet(j,i)=gthet(j,-i)
1283        enddo
1284       enddo
1285       write (2,*) "End reading THETA_PDB"
1286       close (ithep_pdb)
1287 #endif
1288       close(ithep)
1289 !--------------- Reading theta parameters for nucleic acid-------
1290       read (ithep_nucl,*,err=111,end=111) nthetyp_nucl,ntheterm_nucl,&
1291       ntheterm2_nucl,ntheterm3_nucl,nsingle_nucl,ndouble_nucl
1292       nntheterm_nucl=max0(ntheterm_nucl,ntheterm2_nucl,ntheterm3_nucl)
1293       allocate(ithetyp_nucl(ntyp1_molec(2))) !(-ntyp1:ntyp1)
1294       allocate(aa0thet_nucl(nthetyp_nucl+1,&
1295         nthetyp_nucl+1,nthetyp_nucl+1))
1296 !(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
1297       allocate(aathet_nucl(ntheterm_nucl+1,nthetyp_nucl+1,&
1298         nthetyp_nucl+1,nthetyp_nucl+1))
1299 !(maxtheterm,-maxthetyp1:maxthetyp1,&
1300 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
1301       allocate(bbthet_nucl(nsingle_nucl+1,ntheterm2_nucl+1,nthetyp_nucl+1,&
1302         nthetyp_nucl+1,nthetyp_nucl+1))
1303       allocate(ccthet_nucl(nsingle_nucl+1,ntheterm2_nucl+1,nthetyp_nucl+1,&
1304         nthetyp_nucl+1,nthetyp_nucl+1))
1305       allocate(ddthet_nucl(nsingle_nucl+1,ntheterm2_nucl+1,nthetyp_nucl+1,&
1306         nthetyp_nucl+1,nthetyp_nucl+1))
1307       allocate(eethet_nucl(nsingle_nucl+1,ntheterm2_nucl+1,nthetyp_nucl+1,&
1308         nthetyp_nucl+1,nthetyp_nucl+1))
1309 !(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
1310 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
1311       allocate(ffthet_nucl(ndouble_nucl+1,ndouble_nucl+1,ntheterm3_nucl+1,&
1312          nthetyp_nucl+1,nthetyp_nucl+1,nthetyp_nucl+1))
1313       allocate(ggthet_nucl(ndouble_nucl+1,ndouble_nucl+1,ntheterm3_nucl+1,&
1314          nthetyp_nucl+1,nthetyp_nucl+1,nthetyp_nucl+1))
1315
1316 !(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,&
1317 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
1318
1319       read (ithep_nucl,*,err=111,end=111) (ithetyp_nucl(i),i=1,ntyp1_molec(2))
1320
1321       aa0thet_nucl(:,:,:)=0.0d0
1322       aathet_nucl(:,:,:,:)=0.0d0
1323       bbthet_nucl(:,:,:,:,:)=0.0d0
1324       ccthet_nucl(:,:,:,:,:)=0.0d0
1325       ddthet_nucl(:,:,:,:,:)=0.0d0
1326       eethet_nucl(:,:,:,:,:)=0.0d0
1327       ffthet_nucl(:,:,:,:,:,:)=0.0d0
1328       ggthet_nucl(:,:,:,:,:,:)=0.0d0
1329
1330       do i=1,nthetyp_nucl
1331         do j=1,nthetyp_nucl
1332           do k=1,nthetyp_nucl
1333             read (ithep_nucl,'(3a)',end=111,err=111) t1,t2,t3
1334             read (ithep_nucl,*,end=111,err=111) aa0thet_nucl(i,j,k)
1335             read (ithep_nucl,*,end=111,err=111)(aathet_nucl(l,i,j,k),l=1,ntheterm_nucl)
1336             read (ithep_nucl,*,end=111,err=111) &
1337             (((bbthet_nucl(lll,ll,i,j,k),lll=1,nsingle_nucl), &
1338             (ccthet_nucl(lll,ll,i,j,k),lll=1,nsingle_nucl), &
1339             (ddthet_nucl(lll,ll,i,j,k),lll=1,nsingle_nucl), &
1340             (eethet_nucl(lll,ll,i,j,k),lll=1,nsingle_nucl)),ll=1,ntheterm2_nucl)
1341             read (ithep_nucl,*,end=111,err=111) &
1342            (((ffthet_nucl(llll,lll,ll,i,j,k),ffthet_nucl(lll,llll,ll,i,j,k), &
1343               ggthet_nucl(llll,lll,ll,i,j,k),ggthet_nucl(lll,llll,ll,i,j,k), &
1344               llll=1,lll-1),lll=2,ndouble_nucl),ll=1,ntheterm3_nucl)
1345           enddo
1346         enddo
1347       enddo
1348
1349 !-------------------------------------------
1350       allocate(nlob(ntyp1)) !(ntyp1)
1351       allocate(bsc(maxlob,ntyp)) !(maxlob,ntyp)
1352       allocate(censc(3,maxlob,-ntyp:ntyp)) !(3,maxlob,-ntyp:ntyp)
1353       allocate(gaussc(3,3,maxlob,-ntyp:ntyp)) !(3,3,maxlob,-ntyp:ntyp)
1354
1355       bsc(:,:)=0.0D0
1356       nlob(:)=0
1357       nlob(:)=0
1358       dsc(:)=0.0D0
1359       censc(:,:,:)=0.0D0
1360       gaussc(:,:,:,:)=0.0D0
1361
1362 #ifdef CRYST_SC
1363 !
1364 ! Read the parameters of the probability distribution/energy expression
1365 ! of the side chains.
1366 !
1367       do i=1,ntyp
1368         read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i)
1369         if (i.eq.10) then
1370           dsc_inv(i)=0.0D0
1371         else
1372           dsc_inv(i)=1.0D0/dsc(i)
1373         endif
1374         if (i.ne.10) then
1375         do j=1,nlob(i)
1376           do k=1,3
1377             do l=1,3
1378               blower(l,k,j)=0.0D0
1379             enddo
1380           enddo
1381         enddo
1382         bsc(1,i)=0.0D0
1383         read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3),&
1384           ((blower(k,l,1),l=1,k),k=1,3)
1385         censc(1,1,-i)=censc(1,1,i)
1386         censc(2,1,-i)=censc(2,1,i)
1387         censc(3,1,-i)=-censc(3,1,i)
1388         do j=2,nlob(i)
1389           read (irotam,*,end=112,err=112) bsc(j,i)
1390           read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3),&
1391                                        ((blower(k,l,j),l=1,k),k=1,3)
1392         censc(1,j,-i)=censc(1,j,i)
1393         censc(2,j,-i)=censc(2,j,i)
1394         censc(3,j,-i)=-censc(3,j,i)
1395 ! BSC is amplitude of Gaussian
1396         enddo
1397         do j=1,nlob(i)
1398           do k=1,3
1399             do l=1,k
1400               akl=0.0D0
1401               do m=1,3
1402                 akl=akl+blower(k,m,j)*blower(l,m,j)
1403               enddo
1404               gaussc(k,l,j,i)=akl
1405               gaussc(l,k,j,i)=akl
1406              if (((k.eq.3).and.(l.ne.3)) &
1407               .or.((l.eq.3).and.(k.ne.3))) then
1408                 gaussc(k,l,j,-i)=-akl
1409                 gaussc(l,k,j,-i)=-akl
1410               else
1411                 gaussc(k,l,j,-i)=akl
1412                 gaussc(l,k,j,-i)=akl
1413               endif
1414             enddo
1415           enddo
1416         enddo
1417         endif
1418       enddo
1419       close (irotam)
1420       if (lprint) then
1421         write (iout,'(/a)') 'Parameters of side-chain local geometry'
1422         do i=1,ntyp
1423           nlobi=nlob(i)
1424           if (nlobi.gt.0) then
1425             if (LaTeX) then
1426               write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i,1),&
1427                ' # of gaussian lobes:',nlobi,' dsc:',dsc(i)
1428                write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') &
1429                                    'log h',(bsc(j,i),j=1,nlobi)
1430                write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') &
1431               'x',((censc(k,j,i),k=1,3),j=1,nlobi)
1432               do k=1,3
1433                 write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') &
1434                        ((gaussc(k,l,j,i),l=1,3),j=1,nlobi)
1435               enddo
1436             else
1437               write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi)
1438               write (iout,'(a,f10.4,4(16x,f10.4))') &
1439                                    'Center  ',(bsc(j,i),j=1,nlobi)
1440               write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3),&
1441                  j=1,nlobi)
1442               write (iout,'(a)')
1443             endif
1444           endif
1445         enddo
1446       endif
1447 #else
1448 !
1449 ! Read scrot parameters for potentials determined from all-atom AM1 calculations
1450 ! added by Urszula Kozlowska 07/11/2007
1451 !
1452 !el Maximum number of SC local term fitting function coefficiants
1453 !el      integer,parameter :: maxsccoef=65
1454
1455       allocate(sc_parmin(65,ntyp))      !(maxsccoef,ntyp)
1456
1457       do i=1,ntyp
1458         read (irotam,*,end=112,err=112)
1459        if (i.eq.10) then
1460          read (irotam,*,end=112,err=112)
1461        else
1462          do j=1,65
1463            read(irotam,*,end=112,err=112) sc_parmin(j,i)
1464          enddo
1465        endif
1466       enddo
1467 !---------reading nucleic acid parameters for rotamers-------------------
1468       allocate(sc_parmin_nucl(9,ntyp_molec(2)))      !(maxsccoef,ntyp)
1469       do i=1,ntyp_molec(2)
1470         read (irotam_nucl,*,end=112,err=112)
1471         do j=1,9
1472           read(irotam_nucl,*,end=112,err=112) sc_parmin_nucl(j,i)
1473         enddo
1474       enddo
1475       close(irotam_nucl)
1476       if (lprint) then
1477         write (iout,*)
1478         write (iout,*) "Base rotamer parameters"
1479         do i=1,ntyp_molec(2)
1480           write (iout,'(a)') restyp(i,2)
1481           write (iout,'(i5,f10.5)') (i,sc_parmin_nucl(j,i),j=1,9)
1482         enddo
1483       endif
1484
1485 !
1486 ! Read the parameters of the probability distribution/energy expression
1487 ! of the side chains.
1488 !
1489       write (2,*) "Start reading ROTAM_PDB"
1490       do i=1,ntyp
1491         read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i)
1492         if (i.eq.10) then
1493           dsc_inv(i)=0.0D0
1494         else
1495           dsc_inv(i)=1.0D0/dsc(i)
1496         endif
1497         if (i.ne.10) then
1498         do j=1,nlob(i)
1499           do k=1,3
1500             do l=1,3
1501               blower(l,k,j)=0.0D0
1502             enddo
1503           enddo
1504         enddo
1505         bsc(1,i)=0.0D0
1506         read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3),&
1507           ((blower(k,l,1),l=1,k),k=1,3)
1508         do j=2,nlob(i)
1509           read (irotam_pdb,*,end=112,err=112) bsc(j,i)
1510           read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3),&
1511                                        ((blower(k,l,j),l=1,k),k=1,3)
1512         enddo
1513         do j=1,nlob(i)
1514           do k=1,3
1515             do l=1,k
1516               akl=0.0D0
1517               do m=1,3
1518                 akl=akl+blower(k,m,j)*blower(l,m,j)
1519               enddo
1520               gaussc(k,l,j,i)=akl
1521               gaussc(l,k,j,i)=akl
1522             enddo
1523           enddo
1524         enddo
1525         endif
1526       enddo
1527       close (irotam_pdb)
1528       write (2,*) "End reading ROTAM_PDB"
1529 #endif
1530       close(irotam)
1531
1532
1533 !C
1534 !C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local
1535 !C         interaction energy of the Gly, Ala, and Pro prototypes.
1536 !C
1537       read (ifourier,*) nloctyp
1538       SPLIT_FOURIERTOR = nloctyp.lt.0
1539       nloctyp = iabs(nloctyp)
1540 !C      allocate(b1(2,nres))      !(2,-maxtor:maxtor)
1541 !C      allocate(b2(2,nres))      !(2,-maxtor:maxtor)
1542 !C      allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
1543 !C      allocate(ctilde(2,2,nres))
1544 !C      allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
1545 !C      allocate(gtb1(2,nres))
1546 !C      allocate(gtb2(2,nres))
1547 !C      allocate(cc(2,2,nres))
1548 !C      allocate(dd(2,2,nres))
1549 !C      allocate(ee(2,2,nres))
1550 !C      allocate(gtcc(2,2,nres))
1551 !C      allocate(gtdd(2,2,nres))
1552 !C      allocate(gtee(2,2,nres))
1553
1554 #ifdef NEWCORR
1555       allocate(itype2loc(-ntyp1:ntyp1))
1556       allocate(iloctyp(-nloctyp:nloctyp))
1557       allocate(bnew1(3,2,-nloctyp:nloctyp))
1558       allocate(bnew2(3,2,-nloctyp:nloctyp))
1559       allocate(ccnew(3,2,-nloctyp:nloctyp))
1560       allocate(ddnew(3,2,-nloctyp:nloctyp))
1561       allocate(e0new(3,-nloctyp:nloctyp))
1562       allocate(eenew(2,2,2,-nloctyp:nloctyp))
1563       allocate(bnew1tor(3,2,-nloctyp:nloctyp))
1564       allocate(bnew2tor(3,2,-nloctyp:nloctyp))
1565       allocate(ccnewtor(3,2,-nloctyp:nloctyp))
1566       allocate(ddnewtor(3,2,-nloctyp:nloctyp))
1567       allocate(e0newtor(3,-nloctyp:nloctyp))
1568       allocate(eenewtor(2,2,2,-nloctyp:nloctyp))
1569
1570       read (ifourier,*,end=115,err=115) (itype2loc(i),i=1,ntyp)
1571       read (ifourier,*,end=115,err=115) (iloctyp(i),i=0,nloctyp-1)
1572       itype2loc(ntyp1)=nloctyp
1573       iloctyp(nloctyp)=ntyp1
1574       do i=1,ntyp1
1575         itype2loc(-i)=-itype2loc(i)
1576       enddo
1577 #else
1578       allocate(iloctyp(-nloctyp:nloctyp))
1579       allocate(itype2loc(-ntyp1:ntyp1))
1580       iloctyp(0)=10
1581       iloctyp(1)=9
1582       iloctyp(2)=20
1583       iloctyp(3)=ntyp1
1584 #endif
1585       do i=1,nloctyp
1586         iloctyp(-i)=-iloctyp(i)
1587       enddo
1588 !c      write (iout,*) "itype2loc",(itype2loc(i),i=1,ntyp1)
1589 !c      write (iout,*) "nloctyp",nloctyp,
1590 !c     &  " iloctyp",(iloctyp(i),i=0,nloctyp)
1591 !c      write (iout,*) "itype2loc",(itype2loc(i),i=1,ntyp1)
1592 !c      write (iout,*) "nloctyp",nloctyp,
1593 !c     &  " iloctyp",(iloctyp(i),i=0,nloctyp)
1594 #ifdef NEWCORR
1595       do i=0,nloctyp-1
1596 !c             write (iout,*) "NEWCORR",i
1597         read (ifourier,*,end=115,err=115)
1598         do ii=1,3
1599           do j=1,2
1600             read (ifourier,*,end=115,err=115) bnew1(ii,j,i)
1601           enddo
1602         enddo
1603 !c             write (iout,*) "NEWCORR BNEW1"
1604 !c             write (iout,*) ((bnew1(ii,j,i),ii=1,3),j=1,2)
1605         do ii=1,3
1606           do j=1,2
1607             read (ifourier,*,end=115,err=115) bnew2(ii,j,i)
1608           enddo
1609         enddo
1610 !c             write (iout,*) "NEWCORR BNEW2"
1611 !c             write (iout,*) ((bnew2(ii,j,i),ii=1,3),j=1,2)
1612         do kk=1,3
1613           read (ifourier,*,end=115,err=115) ccnew(kk,1,i)
1614           read (ifourier,*,end=115,err=115) ccnew(kk,2,i)
1615         enddo
1616 !c             write (iout,*) "NEWCORR CCNEW"
1617 !c             write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2)
1618         do kk=1,3
1619           read (ifourier,*,end=115,err=115) ddnew(kk,1,i)
1620           read (ifourier,*,end=115,err=115) ddnew(kk,2,i)
1621         enddo
1622 !c             write (iout,*) "NEWCORR DDNEW"
1623 !c             write (iout,*) ((ddnew(ii,j,i),ii=1,3),j=1,2)
1624         do ii=1,2
1625           do jj=1,2
1626             do kk=1,2
1627               read (ifourier,*,end=115,err=115) eenew(ii,jj,kk,i)
1628             enddo
1629           enddo
1630         enddo
1631 !c             write (iout,*) "NEWCORR EENEW1"
1632 !c             write(iout,*)(((eenew(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2)
1633         do ii=1,3
1634           read (ifourier,*,end=115,err=115) e0new(ii,i)
1635         enddo
1636 !c             write (iout,*) (e0new(ii,i),ii=1,3)
1637       enddo
1638 !c             write (iout,*) "NEWCORR EENEW"
1639       do i=0,nloctyp-1
1640         do ii=1,3
1641           ccnew(ii,1,i)=ccnew(ii,1,i)/2
1642           ccnew(ii,2,i)=ccnew(ii,2,i)/2
1643           ddnew(ii,1,i)=ddnew(ii,1,i)/2
1644           ddnew(ii,2,i)=ddnew(ii,2,i)/2
1645         enddo
1646       enddo
1647       do i=1,nloctyp-1
1648         do ii=1,3
1649           bnew1(ii,1,-i)= bnew1(ii,1,i)
1650           bnew1(ii,2,-i)=-bnew1(ii,2,i)
1651           bnew2(ii,1,-i)= bnew2(ii,1,i)
1652           bnew2(ii,2,-i)=-bnew2(ii,2,i)
1653         enddo
1654         do ii=1,3
1655 !c          ccnew(ii,1,i)=ccnew(ii,1,i)/2
1656 !c          ccnew(ii,2,i)=ccnew(ii,2,i)/2
1657 !c          ddnew(ii,1,i)=ddnew(ii,1,i)/2
1658 !c          ddnew(ii,2,i)=ddnew(ii,2,i)/2
1659           ccnew(ii,1,-i)=ccnew(ii,1,i)
1660           ccnew(ii,2,-i)=-ccnew(ii,2,i)
1661           ddnew(ii,1,-i)=ddnew(ii,1,i)
1662           ddnew(ii,2,-i)=-ddnew(ii,2,i)
1663         enddo
1664         e0new(1,-i)= e0new(1,i)
1665         e0new(2,-i)=-e0new(2,i)
1666         e0new(3,-i)=-e0new(3,i)
1667         do kk=1,2
1668           eenew(kk,1,1,-i)= eenew(kk,1,1,i)
1669           eenew(kk,1,2,-i)=-eenew(kk,1,2,i)
1670           eenew(kk,2,1,-i)=-eenew(kk,2,1,i)
1671           eenew(kk,2,2,-i)= eenew(kk,2,2,i)
1672         enddo
1673       enddo
1674       if (lprint) then
1675         write (iout,'(a)') "Coefficients of the multibody terms"
1676         do i=-nloctyp+1,nloctyp-1
1677           write (iout,*) "Type: ",onelet(iloctyp(i))
1678           write (iout,*) "Coefficients of the expansion of B1"
1679           do j=1,2
1680             write (iout,'(3hB1(,i1,1h),3f10.5)') j,(bnew1(k,j,i),k=1,3)
1681           enddo
1682           write (iout,*) "Coefficients of the expansion of B2"
1683           do j=1,2
1684             write (iout,'(3hB2(,i1,1h),3f10.5)') j,(bnew2(k,j,i),k=1,3)
1685           enddo
1686           write (iout,*) "Coefficients of the expansion of C"
1687           write (iout,'(3hC11,3f10.5)') (ccnew(j,1,i),j=1,3)
1688           write (iout,'(3hC12,3f10.5)') (ccnew(j,2,i),j=1,3)
1689           write (iout,*) "Coefficients of the expansion of D"
1690           write (iout,'(3hD11,3f10.5)') (ddnew(j,1,i),j=1,3)
1691           write (iout,'(3hD12,3f10.5)') (ddnew(j,2,i),j=1,3)
1692           write (iout,*) "Coefficients of the expansion of E"
1693           write (iout,'(2hE0,3f10.5)') (e0new(j,i),j=1,3)
1694           do j=1,2
1695             do k=1,2
1696               write (iout,'(1hE,2i1,2f10.5)') j,k,(eenew(l,j,k,i),l=1,2)
1697             enddo
1698           enddo
1699         enddo
1700       endif
1701       IF (SPLIT_FOURIERTOR) THEN
1702       do i=0,nloctyp-1
1703 !c             write (iout,*) "NEWCORR TOR",i
1704         read (ifourier,*,end=115,err=115)
1705         do ii=1,3
1706           do j=1,2
1707             read (ifourier,*,end=115,err=115) bnew1tor(ii,j,i)
1708           enddo
1709         enddo
1710 !c             write (iout,*) "NEWCORR BNEW1 TOR"
1711 !c             write (iout,*) ((bnew1tor(ii,j,i),ii=1,3),j=1,2)
1712         do ii=1,3
1713           do j=1,2
1714             read (ifourier,*,end=115,err=115) bnew2tor(ii,j,i)
1715           enddo
1716         enddo
1717 !c             write (iout,*) "NEWCORR BNEW2 TOR"
1718 !c             write (iout,*) ((bnew2tor(ii,j,i),ii=1,3),j=1,2)
1719         do kk=1,3
1720           read (ifourier,*,end=115,err=115) ccnewtor(kk,1,i)
1721           read (ifourier,*,end=115,err=115) ccnewtor(kk,2,i)
1722         enddo
1723 !c             write (iout,*) "NEWCORR CCNEW TOR"
1724 !c             write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2)
1725         do kk=1,3
1726           read (ifourier,*,end=115,err=115) ddnewtor(kk,1,i)
1727           read (ifourier,*,end=115,err=115) ddnewtor(kk,2,i)
1728         enddo
1729 !c             write (iout,*) "NEWCORR DDNEW TOR"
1730 !c             write (iout,*) ((ddnewtor(ii,j,i),ii=1,3),j=1,2)
1731         do ii=1,2
1732           do jj=1,2
1733             do kk=1,2
1734               read (ifourier,*,end=115,err=115) eenewtor(ii,jj,kk,i)
1735             enddo
1736           enddo
1737         enddo
1738 !c         write (iout,*) "NEWCORR EENEW1 TOR"
1739 !c         write(iout,*)(((eenewtor(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2)
1740         do ii=1,3
1741           read (ifourier,*,end=115,err=115) e0newtor(ii,i)
1742         enddo
1743 !c             write (iout,*) (e0newtor(ii,i),ii=1,3)
1744       enddo
1745 !c             write (iout,*) "NEWCORR EENEW TOR"
1746       do i=0,nloctyp-1
1747         do ii=1,3
1748           ccnewtor(ii,1,i)=ccnewtor(ii,1,i)/2
1749           ccnewtor(ii,2,i)=ccnewtor(ii,2,i)/2
1750           ddnewtor(ii,1,i)=ddnewtor(ii,1,i)/2
1751           ddnewtor(ii,2,i)=ddnewtor(ii,2,i)/2
1752         enddo
1753       enddo
1754       do i=1,nloctyp-1
1755         do ii=1,3
1756           bnew1tor(ii,1,-i)= bnew1tor(ii,1,i)
1757           bnew1tor(ii,2,-i)=-bnew1tor(ii,2,i)
1758           bnew2tor(ii,1,-i)= bnew2tor(ii,1,i)
1759           bnew2tor(ii,2,-i)=-bnew2tor(ii,2,i)
1760         enddo
1761         do ii=1,3
1762           ccnewtor(ii,1,-i)=ccnewtor(ii,1,i)
1763           ccnewtor(ii,2,-i)=-ccnewtor(ii,2,i)
1764           ddnewtor(ii,1,-i)=ddnewtor(ii,1,i)
1765           ddnewtor(ii,2,-i)=-ddnewtor(ii,2,i)
1766         enddo
1767         e0newtor(1,-i)= e0newtor(1,i)
1768         e0newtor(2,-i)=-e0newtor(2,i)
1769         e0newtor(3,-i)=-e0newtor(3,i)
1770         do kk=1,2
1771           eenewtor(kk,1,1,-i)= eenewtor(kk,1,1,i)
1772           eenewtor(kk,1,2,-i)=-eenewtor(kk,1,2,i)
1773           eenewtor(kk,2,1,-i)=-eenewtor(kk,2,1,i)
1774           eenewtor(kk,2,2,-i)= eenewtor(kk,2,2,i)
1775         enddo
1776       enddo
1777       if (lprint) then
1778         write (iout,'(a)') &
1779          "Single-body coefficients of the torsional potentials"
1780         do i=-nloctyp+1,nloctyp-1
1781           write (iout,*) "Type: ",onelet(iloctyp(i))
1782           write (iout,*) "Coefficients of the expansion of B1tor"
1783           do j=1,2
1784             write (iout,'(3hB1(,i1,1h),3f10.5)') &
1785              j,(bnew1tor(k,j,i),k=1,3)
1786           enddo
1787           write (iout,*) "Coefficients of the expansion of B2tor"
1788           do j=1,2
1789             write (iout,'(3hB2(,i1,1h),3f10.5)') &
1790              j,(bnew2tor(k,j,i),k=1,3)
1791           enddo
1792           write (iout,*) "Coefficients of the expansion of Ctor"
1793           write (iout,'(3hC11,3f10.5)') (ccnewtor(j,1,i),j=1,3)
1794           write (iout,'(3hC12,3f10.5)') (ccnewtor(j,2,i),j=1,3)
1795           write (iout,*) "Coefficients of the expansion of Dtor"
1796           write (iout,'(3hD11,3f10.5)') (ddnewtor(j,1,i),j=1,3)
1797           write (iout,'(3hD12,3f10.5)') (ddnewtor(j,2,i),j=1,3)
1798           write (iout,*) "Coefficients of the expansion of Etor"
1799           write (iout,'(2hE0,3f10.5)') (e0newtor(j,i),j=1,3)
1800           do j=1,2
1801             do k=1,2
1802               write (iout,'(1hE,2i1,2f10.5)') &
1803                j,k,(eenewtor(l,j,k,i),l=1,2)
1804             enddo
1805           enddo
1806         enddo
1807       endif
1808       ELSE
1809       do i=-nloctyp+1,nloctyp-1
1810         do ii=1,3
1811           do j=1,2
1812             bnew1tor(ii,j,i)=bnew1(ii,j,i)
1813           enddo
1814         enddo
1815         do ii=1,3
1816           do j=1,2
1817             bnew2tor(ii,j,i)=bnew2(ii,j,i)
1818           enddo
1819         enddo
1820         do ii=1,3
1821           ccnewtor(ii,1,i)=ccnew(ii,1,i)
1822           ccnewtor(ii,2,i)=ccnew(ii,2,i)
1823           ddnewtor(ii,1,i)=ddnew(ii,1,i)
1824           ddnewtor(ii,2,i)=ddnew(ii,2,i)
1825         enddo
1826       enddo
1827       ENDIF !SPLIT_FOURIER_TOR
1828 #else
1829       allocate(ccold(2,2,-nloctyp-1:nloctyp+1))
1830       allocate(ddold(2,2,-nloctyp-1:nloctyp+1))
1831       allocate(eeold(2,2,-nloctyp-1:nloctyp+1))
1832       allocate(b(13,-nloctyp-1:nloctyp+1))
1833       if (lprint) &
1834        write (iout,*) "Coefficients of the expansion of Eloc(l1,l2)"
1835       do i=0,nloctyp-1
1836         read (ifourier,*,end=115,err=115)
1837         read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13)
1838         if (lprint) then
1839         write (iout,*) 'Type ',onelet(iloctyp(i))
1840         write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13)
1841         endif
1842         if (i.gt.0) then
1843         b(2,-i)= b(2,i)
1844         b(3,-i)= b(3,i)
1845         b(4,-i)=-b(4,i)
1846         b(5,-i)=-b(5,i)
1847         endif
1848 !c        B1(1,i)  = b(3)
1849 !c        B1(2,i)  = b(5)
1850 !c        B1(1,-i) = b(3)
1851 !c        B1(2,-i) = -b(5)
1852 !c        b1(1,i)=0.0d0
1853 !c        b1(2,i)=0.0d0
1854 !c        B1tilde(1,i) = b(3)
1855 !c!        B1tilde(2,i) =-b(5)
1856 !c!        B1tilde(1,-i) =-b(3)
1857 !c!        B1tilde(2,-i) =b(5)
1858 !c!        b1tilde(1,i)=0.0d0
1859 !c        b1tilde(2,i)=0.0d0
1860 !c        B2(1,i)  = b(2)
1861 !c        B2(2,i)  = b(4)
1862 !c        B2(1,-i)  =b(2)
1863 !c        B2(2,-i)  =-b(4)
1864 !cc        B1tilde(1,i) = b(3,i)
1865 !cc        B1tilde(2,i) =-b(5,i)
1866 !c        B1tilde(1,-i) =-b(3,i)
1867 !c        B1tilde(2,-i) =b(5,i)
1868 !cc        b1tilde(1,i)=0.0d0
1869 !cc        b1tilde(2,i)=0.0d0
1870 !cc        B2(1,i)  = b(2,i)
1871 !cc        B2(2,i)  = b(4,i)
1872 !c        B2(1,-i)  =b(2,i)
1873 !c        B2(2,-i)  =-b(4,i)
1874
1875 !c        b2(1,i)=0.0d0
1876 !c        b2(2,i)=0.0d0
1877         CCold(1,1,i)= b(7,i)
1878         CCold(2,2,i)=-b(7,i)
1879         CCold(2,1,i)= b(9,i)
1880         CCold(1,2,i)= b(9,i)
1881         CCold(1,1,-i)= b(7,i)
1882         CCold(2,2,-i)=-b(7,i)
1883         CCold(2,1,-i)=-b(9,i)
1884         CCold(1,2,-i)=-b(9,i)
1885 !c        CC(1,1,i)=0.0d0
1886 !c        CC(2,2,i)=0.0d0
1887 !c        CC(2,1,i)=0.0d0
1888 !c        CC(1,2,i)=0.0d0
1889 !c        Ctilde(1,1,i)= CCold(1,1,i)
1890 !c        Ctilde(1,2,i)= CCold(1,2,i)
1891 !c        Ctilde(2,1,i)=-CCold(2,1,i)
1892 !c        Ctilde(2,2,i)=-CCold(2,2,i)
1893 !c        CC(1,1,i)=0.0d0
1894 !c        CC(2,2,i)=0.0d0
1895 !c        CC(2,1,i)=0.0d0
1896 !c        CC(1,2,i)=0.0d0
1897 !c        Ctilde(1,1,i)= CCold(1,1,i)
1898 !c        Ctilde(1,2,i)= CCold(1,2,i)
1899 !c        Ctilde(2,1,i)=-CCold(2,1,i)
1900 !c        Ctilde(2,2,i)=-CCold(2,2,i)
1901
1902 !c        Ctilde(1,1,i)=0.0d0
1903 !c        Ctilde(1,2,i)=0.0d0
1904 !c        Ctilde(2,1,i)=0.0d0
1905 !c        Ctilde(2,2,i)=0.0d0
1906         DDold(1,1,i)= b(6,i)
1907         DDold(2,2,i)=-b(6,i)
1908         DDold(2,1,i)= b(8,i)
1909         DDold(1,2,i)= b(8,i)
1910         DDold(1,1,-i)= b(6,i)
1911         DDold(2,2,-i)=-b(6,i)
1912         DDold(2,1,-i)=-b(8,i)
1913         DDold(1,2,-i)=-b(8,i)
1914 !c        DD(1,1,i)=0.0d0
1915 !c        DD(2,2,i)=0.0d0
1916 !c        DD(2,1,i)=0.0d0
1917 !c        DD(1,2,i)=0.0d0
1918 !c        Dtilde(1,1,i)= DD(1,1,i)
1919 !c        Dtilde(1,2,i)= DD(1,2,i)
1920 !c        Dtilde(2,1,i)=-DD(2,1,i)
1921 !c        Dtilde(2,2,i)=-DD(2,2,i)
1922
1923 !c        Dtilde(1,1,i)=0.0d0
1924 !c        Dtilde(1,2,i)=0.0d0
1925 !c        Dtilde(2,1,i)=0.0d0
1926 !c        Dtilde(2,2,i)=0.0d0
1927         EEold(1,1,i)= b(10,i)+b(11,i)
1928         EEold(2,2,i)=-b(10,i)+b(11,i)
1929         EEold(2,1,i)= b(12,i)-b(13,i)
1930         EEold(1,2,i)= b(12,i)+b(13,i)
1931         EEold(1,1,-i)= b(10,i)+b(11,i)
1932         EEold(2,2,-i)=-b(10,i)+b(11,i)
1933         EEold(2,1,-i)=-b(12,i)+b(13,i)
1934         EEold(1,2,-i)=-b(12,i)-b(13,i)
1935         write(iout,*) "TU DOCHODZE"
1936         print *,"JESTEM"
1937 !c        ee(1,1,i)=1.0d0
1938 !c        ee(2,2,i)=1.0d0
1939 !c        ee(2,1,i)=0.0d0
1940 !c        ee(1,2,i)=0.0d0
1941 !c        ee(2,1,i)=ee(1,2,i)
1942       enddo
1943       if (lprint) then
1944       write (iout,*)
1945       write (iout,*) &
1946       "Coefficients of the cumulants (independent of valence angles)"
1947       do i=-nloctyp+1,nloctyp-1
1948         write (iout,*) 'Type ',onelet(iloctyp(i))
1949         write (iout,*) 'B1'
1950         write(iout,'(2f10.5)') B(3,i),B(5,i)
1951         write (iout,*) 'B2'
1952         write(iout,'(2f10.5)') B(2,i),B(4,i)
1953         write (iout,*) 'CC'
1954         do j=1,2
1955           write (iout,'(2f10.5)') CCold(j,1,i),CCold(j,2,i)
1956         enddo
1957         write(iout,*) 'DD'
1958         do j=1,2
1959           write (iout,'(2f10.5)') DDold(j,1,i),DDold(j,2,i)
1960         enddo
1961         write(iout,*) 'EE'
1962         do j=1,2
1963           write (iout,'(2f10.5)') EEold(j,1,i),EEold(j,2,i)
1964         enddo
1965       enddo
1966       endif
1967 #endif
1968
1969
1970 #ifdef CRYST_TOR
1971 !
1972 ! Read torsional parameters in old format
1973 !
1974       allocate(itortyp(ntyp1)) !(-ntyp1:ntyp1)
1975
1976       read (itorp,*,end=113,err=113) ntortyp,nterm_old
1977       if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old
1978       read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp)
1979
1980 !el from energy module--------
1981       allocate(v1(nterm_old,ntortyp,ntortyp))
1982       allocate(v2(nterm_old,ntortyp,ntortyp)) !(maxterm,-maxtor:maxtor,-maxtor:maxtor)
1983 !el---------------------------
1984       do i=1,ntortyp
1985         do j=1,ntortyp
1986           read (itorp,'(a)')
1987           do k=1,nterm_old
1988             read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i)
1989           enddo
1990         enddo
1991       enddo
1992       close (itorp)
1993       if (lprint) then
1994         write (iout,'(/a/)') 'Torsional constants:'
1995         do i=1,ntortyp
1996           do j=1,ntortyp
1997             write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old)
1998             write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old)
1999           enddo
2000         enddo
2001       endif
2002 #else
2003 !
2004 ! Read torsional parameters
2005 !
2006       IF (TOR_MODE.eq.0) THEN
2007       allocate(itortyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1)
2008       read (itorp,*,end=113,err=113) ntortyp
2009 !el from energy module---------
2010       allocate(nterm(-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(-maxtor:maxtor,-maxtor:maxtor,2)
2011       allocate(nlor(-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(-maxtor:maxtor,-maxtor:maxtor,2)
2012
2013       allocate(vlor1(maxlor,-ntortyp:ntortyp,-ntortyp:ntortyp)) !(maxlor,-maxtor:maxtor,-maxtor:maxtor)
2014       allocate(vlor2(maxlor,ntortyp,ntortyp))
2015       allocate(vlor3(maxlor,ntortyp,ntortyp)) !(maxlor,maxtor,maxtor)
2016       allocate(v0(-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(-maxtor:maxtor,-maxtor:maxtor,2)
2017
2018       allocate(v1(maxterm,-ntortyp:ntortyp,-ntortyp:ntortyp,2))
2019       allocate(v2(maxterm,-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)
2020 !el---------------------------
2021       nterm(:,:,:)=0
2022       nlor(:,:,:)=0
2023 !el---------------------------
2024
2025       read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp)
2026       do i=-ntyp,-1
2027        itortyp(i)=-itortyp(-i)
2028       enddo
2029       itortyp(ntyp1)=ntortyp
2030       itortyp(-ntyp1)=-ntortyp
2031       do iblock=1,2
2032       write (iout,*) 'ntortyp',ntortyp
2033       do i=0,ntortyp-1
2034         do j=-ntortyp+1,ntortyp-1
2035           read (itorp,*,end=113,err=113) nterm(i,j,iblock),&
2036                 nlor(i,j,iblock)
2037           nterm(-i,-j,iblock)=nterm(i,j,iblock)
2038           nlor(-i,-j,iblock)=nlor(i,j,iblock)
2039           v0ij=0.0d0
2040           si=-1.0d0
2041           do k=1,nterm(i,j,iblock)
2042             read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock),&
2043             v2(k,i,j,iblock)
2044             v1(k,-i,-j,iblock)=v1(k,i,j,iblock)
2045             v2(k,-i,-j,iblock)=-v2(k,i,j,iblock)
2046             v0ij=v0ij+si*v1(k,i,j,iblock)
2047             si=-si
2048 !         write(iout,*) i,j,k,iblock,nterm(i,j,iblock) !
2049 !         write(iout,*) v1(k,-i,-j,iblock),v1(k,i,j,iblock),&!
2050 !      v2(k,-i,-j,iblock),v2(k,i,j,iblock)!
2051           enddo
2052           do k=1,nlor(i,j,iblock)
2053             read (itorp,*,end=113,err=113) kk,vlor1(k,i,j),&
2054               vlor2(k,i,j),vlor3(k,i,j)
2055             v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2)
2056           enddo
2057           v0(i,j,iblock)=v0ij
2058           v0(-i,-j,iblock)=v0ij
2059         enddo
2060       enddo
2061       enddo
2062       close (itorp)
2063       if (lprint) then
2064         write (iout,'(/a/)') 'Torsional constants:'
2065         do iblock=1,2
2066         do i=-ntortyp,ntortyp
2067           do j=-ntortyp,ntortyp
2068             write (iout,*) 'ityp',i,' jtyp',j
2069             write (iout,*) 'Fourier constants'
2070             do k=1,nterm(i,j,iblock)
2071               write (iout,'(2(1pe15.5))') v1(k,i,j,iblock),&
2072               v2(k,i,j,iblock)
2073             enddo
2074             write (iout,*) 'Lorenz constants'
2075             do k=1,nlor(i,j,iblock)
2076               write (iout,'(3(1pe15.5))') &
2077                vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
2078             enddo
2079           enddo
2080         enddo
2081         enddo
2082       endif
2083 !elwrite (iout,'(/a/)') 'Torsional constants:',vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
2084 !
2085 ! 6/23/01 Read parameters for double torsionals
2086 !
2087 !el from energy module------------
2088       allocate(v1c(2,maxtermd_1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2))
2089       allocate(v1s(2,maxtermd_1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2))
2090 !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
2091       allocate(v2c(maxtermd_2,maxtermd_2,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2))
2092       allocate(v2s(maxtermd_2,maxtermd_2,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2))
2093         !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
2094       allocate(ntermd_1(-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2))
2095       allocate(ntermd_2(-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,-ntortyp+1:ntortyp-1,2))
2096         !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2)
2097 !---------------------------------
2098
2099       do iblock=1,2
2100       do i=0,ntortyp-1
2101         do j=-ntortyp+1,ntortyp-1
2102           do k=-ntortyp+1,ntortyp-1
2103             read (itordp,'(3a1)',end=114,err=114) t1,t2,t3
2104 !              write (iout,*) "OK onelett",
2105 !     &         i,j,k,t1,t2,t3
2106
2107             if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) &
2108               .or. t3.ne.toronelet(k)) then
2109              write (iout,*) "Error in double torsional parameter file",&
2110                i,j,k,t1,t2,t3
2111 #ifdef MPI
2112               call MPI_Finalize(Ierror)
2113 #endif
2114                stop "Error in double torsional parameter file"
2115             endif
2116            read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock),&
2117                ntermd_2(i,j,k,iblock)
2118             ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock)
2119             ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock)
2120             read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1,&
2121                ntermd_1(i,j,k,iblock))
2122             read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1,&
2123                ntermd_1(i,j,k,iblock))
2124             read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1,&
2125                ntermd_1(i,j,k,iblock))
2126             read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1,&
2127                ntermd_1(i,j,k,iblock))
2128 ! Martix of D parameters for one dimesional foureir series
2129             do l=1,ntermd_1(i,j,k,iblock)
2130              v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock)
2131              v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock)
2132              v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock)
2133              v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock)
2134 !            write(iout,*) "whcodze" ,
2135 !     & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock)
2136             enddo
2137             read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock),&
2138                v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock),&
2139                v2s(m,l,i,j,k,iblock),&
2140                m=1,l-1),l=1,ntermd_2(i,j,k,iblock))
2141 ! Martix of D parameters for two dimesional fourier series
2142             do l=1,ntermd_2(i,j,k,iblock)
2143              do m=1,l-1
2144              v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock)
2145              v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock)
2146              v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock)
2147              v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock)
2148              enddo!m
2149             enddo!l
2150           enddo!k
2151         enddo!j
2152       enddo!i
2153       enddo!iblock
2154       if (lprint) then
2155       write (iout,*)
2156       write (iout,*) 'Constants for double torsionals'
2157       do iblock=1,2
2158       do i=0,ntortyp-1
2159         do j=-ntortyp+1,ntortyp-1
2160           do k=-ntortyp+1,ntortyp-1
2161             write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k,&
2162               ' nsingle',ntermd_1(i,j,k,iblock),&
2163               ' ndouble',ntermd_2(i,j,k,iblock)
2164             write (iout,*)
2165             write (iout,*) 'Single angles:'
2166             do l=1,ntermd_1(i,j,k,iblock)
2167               write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l,&
2168                  v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock),&
2169                  v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock),&
2170                  v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock)
2171             enddo
2172             write (iout,*)
2173             write (iout,*) 'Pairs of angles:'
2174             write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
2175             do l=1,ntermd_2(i,j,k,iblock)
2176               write (iout,'(i5,20f10.5)') &
2177                l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock))
2178             enddo
2179             write (iout,*)
2180             write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock))
2181             do l=1,ntermd_2(i,j,k,iblock)
2182               write (iout,'(i5,20f10.5)') &
2183                l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)),&
2184                (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock))
2185             enddo
2186             write (iout,*)
2187           enddo
2188         enddo
2189       enddo
2190       enddo
2191       endif
2192 #ifndef NEWCORR
2193       do i=1,ntyp1
2194         itype2loc(i)=itortyp(i)
2195       enddo
2196 #endif
2197
2198       ELSE IF (TOR_MODE.eq.1) THEN
2199
2200 !C read valence-torsional parameters
2201       read (itorp,*,end=121,err=121) ntortyp
2202       nkcctyp=ntortyp
2203       write (iout,*) "Valence-torsional parameters read in ntortyp",&
2204         ntortyp
2205       read (itorp,*,end=121,err=121) (itortyp(i),i=1,ntyp)
2206       write (iout,*) "itortyp_kcc",(itortyp(i),i=1,ntyp)
2207 #ifndef NEWCORR
2208       do i=1,ntyp1
2209         itype2loc(i)=itortyp(i)
2210       enddo
2211 #endif
2212       do i=-ntyp,-1
2213         itortyp(i)=-itortyp(-i)
2214       enddo
2215       do i=-ntortyp+1,ntortyp-1
2216         do j=-ntortyp+1,ntortyp-1
2217 !C first we read the cos and sin gamma parameters
2218           read (itorp,'(13x,a)',end=121,err=121) string
2219           write (iout,*) i,j,string
2220           read (itorp,*,end=121,err=121) &
2221          nterm_kcc(j,i),nterm_kcc_Tb(j,i)
2222 !C           read (itorkcc,*,end=121,err=121) nterm_kcc_Tb(j,i)
2223           do k=1,nterm_kcc(j,i)
2224             do l=1,nterm_kcc_Tb(j,i)
2225               do ll=1,nterm_kcc_Tb(j,i)
2226               read (itorp,*,end=121,err=121) ii,jj,kk, &
2227                v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i)
2228               enddo
2229             enddo
2230           enddo
2231         enddo
2232       enddo
2233       ELSE
2234 #ifdef NEWCORR
2235 !c AL 4/8/16: Calculate coefficients from one-body parameters
2236       ntortyp=nloctyp
2237       allocate(itortyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1)
2238       allocate(nterm_kcc(-ntyp1:ntyp1,-ntyp1:ntyp1))
2239       allocate(nterm_kcc_Tb(-ntyp1:ntyp1,-ntyp1:ntyp1))
2240       allocate(v1_kcc(6,6,6,-ntyp1:ntyp1,-ntyp1:ntyp1))
2241       allocate(v2_kcc(6,6,6,-ntyp1:ntyp1,-ntyp1:ntyp1))
2242
2243       do i=-ntyp1,ntyp1
2244        print *,i,itortyp(i)
2245        itortyp(i)=itype2loc(i)
2246       enddo
2247       write (iout,*) &
2248       "Val-tor parameters calculated from cumulant coefficients ntortyp"&
2249       ,ntortyp
2250       do i=-ntortyp+1,ntortyp-1
2251         do j=-ntortyp+1,ntortyp-1
2252           nterm_kcc(j,i)=2
2253           nterm_kcc_Tb(j,i)=3
2254           do k=1,nterm_kcc_Tb(j,i)
2255             do l=1,nterm_kcc_Tb(j,i)
2256               v1_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,1,j)&
2257                               +bnew1tor(k,2,i)*bnew2tor(l,2,j)
2258               v2_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,2,j)&
2259                               +bnew1tor(k,2,i)*bnew2tor(l,1,j)
2260             enddo
2261           enddo
2262           do k=1,nterm_kcc_Tb(j,i)
2263             do l=1,nterm_kcc_Tb(j,i)
2264 #ifdef CORRCD
2265               v1_kcc(k,l,2,i,j)=-(ccnewtor(k,1,i)*ddnewtor(l,1,j) &
2266                               -ccnewtor(k,2,i)*ddnewtor(l,2,j))
2267               v2_kcc(k,l,2,i,j)=-(ccnewtor(k,2,i)*ddnewtor(l,1,j) &
2268                               +ccnewtor(k,1,i)*ddnewtor(l,2,j))
2269 #else
2270               v1_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,1,i)*ddnewtor(l,1,j) &
2271                               -ccnewtor(k,2,i)*ddnewtor(l,2,j))
2272               v2_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,2,i)*ddnewtor(l,1,j) &
2273                               +ccnewtor(k,1,i)*ddnewtor(l,2,j))
2274 #endif
2275             enddo
2276           enddo
2277 !c f(theta,gamma)=-(b21(theta)*b11(theta)+b12(theta)*b22(theta))*cos(gamma)-(b22(theta)*b11(theta)+b21(theta)*b12(theta))*sin(gamma)+(c11(theta)*d11(theta)-c12(theta)*d12(theta))*cos(2*gamma)+(c12(theta)*d11(theta)+c11(theta)*d12(theta))*sin(2*gamma)
2278         enddo
2279       enddo
2280 #else
2281       write (iout,*) "TOR_MODE>1 only with NEWCORR"
2282       stop
2283 #endif
2284       ENDIF ! TOR_MODE
2285
2286       if (tor_mode.gt.0 .and. lprint) then
2287 !c Print valence-torsional parameters
2288         write (iout,'(a)') &
2289          "Parameters of the valence-torsional potentials"
2290         do i=-ntortyp+1,ntortyp-1
2291         do j=-ntortyp+1,ntortyp-1
2292         write (iout,'(3a)') "Type ",toronelet(i),toronelet(j)
2293         write (iout,'(3a5,2a15)') "itor","ival","jval","v_kcc","v2_kcc"
2294         do k=1,nterm_kcc(j,i)
2295           do l=1,nterm_kcc_Tb(j,i)
2296             do ll=1,nterm_kcc_Tb(j,i)
2297                write (iout,'(3i5,2f15.4)')&
2298                  k,l-1,ll-1,v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i)
2299             enddo
2300           enddo
2301         enddo
2302         enddo
2303         enddo
2304       endif
2305 #endif
2306       allocate(itortyp_nucl(ntyp1_molec(2))) !(-ntyp1:ntyp1)
2307       read (itorp_nucl,*,end=113,err=113) ntortyp_nucl
2308 !      print *,"ntortyp_nucl",ntortyp_nucl,ntyp_molec(2)
2309 !el from energy module---------
2310       allocate(nterm_nucl(ntortyp_nucl,ntortyp_nucl)) !(-maxtor:maxtor,-maxtor:maxtor,2)
2311       allocate(nlor_nucl(ntortyp_nucl,ntortyp_nucl)) !(-maxtor:maxtor,-maxtor:maxtor,2)
2312
2313       allocate(vlor1_nucl(maxlor,ntortyp_nucl,ntortyp_nucl)) !(maxlor,-maxtor:maxtor,-maxtor:maxtor)
2314       allocate(vlor2_nucl(maxlor,ntortyp_nucl,ntortyp_nucl))
2315       allocate(vlor3_nucl(maxlor,ntortyp_nucl,ntortyp_nucl)) !(maxlor,maxtor,maxtor)
2316       allocate(v0_nucl(ntortyp_nucl,ntortyp_nucl)) !(-maxtor:maxtor,-maxtor:maxtor,2)
2317
2318       allocate(v1_nucl(maxterm,ntortyp_nucl,ntortyp_nucl))
2319       allocate(v2_nucl(maxterm,ntortyp_nucl,ntortyp_nucl)) !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)
2320 !el---------------------------
2321       nterm_nucl(:,:)=0
2322       nlor_nucl(:,:)=0
2323 !el--------------------
2324       read (itorp_nucl,*,end=113,err=113) &
2325         (itortyp_nucl(i),i=1,ntyp_molec(2))
2326 !        print *,itortyp_nucl(:)
2327 !c      write (iout,*) 'ntortyp',ntortyp
2328       do i=1,ntortyp_nucl
2329         do j=1,ntortyp_nucl
2330           read (itorp_nucl,*,end=113,err=113) nterm_nucl(i,j),nlor_nucl(i,j)
2331 !           print *,nterm_nucl(i,j),nlor_nucl(i,j)
2332           v0ij=0.0d0
2333           si=-1.0d0
2334           do k=1,nterm_nucl(i,j)
2335             read (itorp_nucl,*,end=113,err=113) kk,v1_nucl(k,i,j),v2_nucl(k,i,j)
2336             v0ij=v0ij+si*v1_nucl(k,i,j)
2337             si=-si
2338           enddo
2339           do k=1,nlor_nucl(i,j)
2340             read (itorp,*,end=113,err=113) kk,vlor1_nucl(k,i,j),&
2341               vlor2_nucl(k,i,j),vlor3_nucl(k,i,j)
2342             v0ij=v0ij+vlor1_nucl(k,i,j)/(1+vlor3_nucl(k,i,j)**2)
2343           enddo
2344           v0_nucl(i,j)=v0ij
2345         enddo
2346       enddo
2347
2348 ! Read of Side-chain backbone correlation parameters
2349 ! Modified 11 May 2012 by Adasko
2350 !CC
2351 !
2352       read (isccor,*,end=119,err=119) nsccortyp
2353
2354 !el from module energy-------------
2355       allocate(nlor_sccor(nsccortyp,nsccortyp)) !(-ntyp:ntyp,-ntyp:ntyp)
2356       allocate(vlor1sccor(maxterm_sccor,nsccortyp,nsccortyp))
2357       allocate(vlor2sccor(maxterm_sccor,nsccortyp,nsccortyp))
2358       allocate(vlor3sccor(maxterm_sccor,nsccortyp,nsccortyp))   !(maxterm_sccor,20,20)
2359 !-----------------------------------
2360 #ifdef SCCORPDB
2361 !el from module energy-------------
2362       allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
2363
2364       read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp)
2365       do i=-ntyp,-1
2366         isccortyp(i)=-isccortyp(-i)
2367       enddo
2368       iscprol=isccortyp(20)
2369 !      write (iout,*) 'ntortyp',ntortyp
2370       maxinter=3
2371 !c maxinter is maximum interaction sites
2372 !el from module energy---------
2373       allocate(nterm_sccor(-nsccortyp:nsccortyp,-nsccortyp:nsccortyp)) !(-ntyp:ntyp,-ntyp:ntyp)
2374       allocate(v1sccor(maxterm_sccor,maxinter,-nsccortyp:nsccortyp,&
2375                -nsccortyp:nsccortyp))
2376       allocate(v2sccor(maxterm_sccor,maxinter,-nsccortyp:nsccortyp,&
2377                -nsccortyp:nsccortyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
2378       allocate(v0sccor(maxinter,-nsccortyp:nsccortyp,&
2379                -nsccortyp:nsccortyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
2380 !-----------------------------------
2381       do l=1,maxinter
2382       do i=1,nsccortyp
2383         do j=1,nsccortyp
2384           read (isccor,*,end=119,err=119) &
2385       nterm_sccor(i,j),nlor_sccor(i,j)
2386           v0ijsccor=0.0d0
2387           v0ijsccor1=0.0d0
2388           v0ijsccor2=0.0d0
2389           v0ijsccor3=0.0d0
2390           si=-1.0d0
2391           nterm_sccor(-i,j)=nterm_sccor(i,j)
2392           nterm_sccor(-i,-j)=nterm_sccor(i,j)
2393           nterm_sccor(i,-j)=nterm_sccor(i,j)
2394           do k=1,nterm_sccor(i,j)
2395             read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j),&
2396            v2sccor(k,l,i,j)
2397             if (j.eq.iscprol) then
2398              if (i.eq.isccortyp(10)) then
2399              v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)
2400              v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
2401              else
2402              v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0 &
2403                               +v2sccor(k,l,i,j)*dsqrt(0.75d0)
2404              v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0 &
2405                               +v1sccor(k,l,i,j)*dsqrt(0.75d0)
2406              v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j)
2407              v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j)
2408              v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j)
2409              v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j)
2410              endif
2411             else
2412              if (i.eq.isccortyp(10)) then
2413              v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)
2414              v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
2415              else
2416                if (j.eq.isccortyp(10)) then
2417              v1sccor(k,l,-i,j)=v1sccor(k,l,i,j)
2418              v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j)
2419                else
2420              v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j)
2421              v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)
2422              v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j)
2423              v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j)
2424              v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j)
2425              v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j)
2426                 endif
2427                endif
2428             endif
2429             v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j)
2430             v0ijsccor1=v0ijsccor+si*v1sccor(k,l,-i,j)
2431             v0ijsccor2=v0ijsccor+si*v1sccor(k,l,i,-j)
2432             v0ijsccor3=v0ijsccor+si*v1sccor(k,l,-i,-j)
2433             si=-si
2434           enddo
2435           do k=1,nlor_sccor(i,j)
2436             read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j),&
2437               vlor2sccor(k,i,j),vlor3sccor(k,i,j)
2438             v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ &
2439       (1+vlor3sccor(k,i,j)**2)
2440           enddo
2441           v0sccor(l,i,j)=v0ijsccor
2442           v0sccor(l,-i,j)=v0ijsccor1
2443           v0sccor(l,i,-j)=v0ijsccor2
2444           v0sccor(l,-i,-j)=v0ijsccor3
2445         enddo
2446       enddo
2447       enddo
2448       close (isccor)
2449 #else
2450 !el from module energy-------------
2451       allocate(isccortyp(ntyp)) !(-ntyp:ntyp)
2452
2453       read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp)
2454 !      write (iout,*) 'ntortyp',ntortyp
2455       maxinter=3
2456 !c maxinter is maximum interaction sites
2457 !el from module energy---------
2458       allocate(nterm_sccor(nsccortyp,nsccortyp)) !(-ntyp:ntyp,-ntyp:ntyp)
2459       allocate(v1sccor(maxterm_sccor,maxinter,nsccortyp,nsccortyp))
2460       allocate(v2sccor(maxterm_sccor,maxinter,nsccortyp,nsccortyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
2461       allocate(v0sccor(maxinter,nsccortyp,nsccortyp)) !???(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
2462 !-----------------------------------
2463       do l=1,maxinter
2464       do i=1,nsccortyp
2465         do j=1,nsccortyp
2466           read (isccor,*,end=119,err=119) &
2467        nterm_sccor(i,j),nlor_sccor(i,j)
2468           v0ijsccor=0.0d0
2469           si=-1.0d0
2470
2471           do k=1,nterm_sccor(i,j)
2472             read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j),&
2473            v2sccor(k,l,i,j)
2474             v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j)
2475             si=-si
2476           enddo
2477           do k=1,nlor_sccor(i,j)
2478             read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j),&
2479               vlor2sccor(k,i,j),vlor3sccor(k,i,j)
2480             v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ &
2481       (1+vlor3sccor(k,i,j)**2)
2482           enddo
2483           v0sccor(l,i,j)=v0ijsccor !el ,iblock
2484         enddo
2485       enddo
2486       enddo
2487       close (isccor)
2488
2489 #endif
2490       if (lprint) then
2491         l=3
2492         write (iout,'(/a/)') 'Torsional constants:'
2493         do i=1,nsccortyp
2494           do j=1,nsccortyp
2495             write (iout,*) 'ityp',i,' jtyp',j
2496             write (iout,*) 'Fourier constants'
2497             do k=1,nterm_sccor(i,j)
2498       write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j)
2499             enddo
2500             write (iout,*) 'Lorenz constants'
2501             do k=1,nlor_sccor(i,j)
2502               write (iout,'(3(1pe15.5))') &
2503                vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j)
2504             enddo
2505           enddo
2506         enddo
2507       endif
2508
2509 !
2510 ! 9/18/99 (AL) Read coefficients of the Fourier expansion of the local
2511 !         interaction energy of the Gly, Ala, and Pro prototypes.
2512 !
2513 !
2514 ! Read electrostatic-interaction parameters
2515 !
2516
2517       if (lprint) then
2518         write (iout,*)
2519         write (iout,'(/a)') 'Electrostatic interaction constants:'
2520         write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') &
2521                   'IT','JT','APP','BPP','AEL6','AEL3'
2522       endif
2523       read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2)
2524       read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2)
2525       read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2)
2526       read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2)
2527       close (ielep)
2528       do i=1,2
2529         do j=1,2
2530         rri=rpp(i,j)**6
2531         app (i,j)=epp(i,j)*rri*rri
2532         bpp (i,j)=-2.0D0*epp(i,j)*rri
2533         ael6(i,j)=elpp6(i,j)*4.2D0**6
2534         ael3(i,j)=elpp3(i,j)*4.2D0**3
2535 !        lprint=.true.
2536         if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j),&
2537                           ael6(i,j),ael3(i,j)
2538 !        lprint=.false.
2539         enddo
2540       enddo
2541 !
2542 ! Read side-chain interaction parameters.
2543 !
2544 !el from module energy - COMMON.INTERACT-------
2545       allocate(eps(ntyp,ntyp),sigmaii(ntyp,ntyp),rs0(ntyp,ntyp)) !(ntyp,ntyp)
2546       allocate(augm(ntyp,ntyp)) !(ntyp,ntyp)
2547       allocate(eps_scp(ntyp,2),rscp(ntyp,2)) !(ntyp,2)
2548
2549       allocate(sigma0(ntyp),rr0(ntyp),sigii(ntyp)) !(ntyp)
2550       allocate(chip(ntyp1),alp(ntyp1)) !(ntyp)
2551       allocate(epslip(ntyp,ntyp))
2552       augm(:,:)=0.0D0
2553       chip(:)=0.0D0
2554       alp(:)=0.0D0
2555       sigma0(:)=0.0D0
2556       sigii(:)=0.0D0
2557       rr0(:)=0.0D0
2558
2559 !--------------------------------
2560
2561       read (isidep,*,end=117,err=117) ipot,expon
2562       if (ipot.lt.1 .or. ipot.gt.5) then
2563         write (iout,'(2a)') 'Error while reading SC interaction',&
2564                      'potential file - unknown potential type.'
2565 #ifdef MPI
2566         call MPI_Finalize(Ierror)
2567 #endif
2568         stop
2569       endif
2570       expon2=expon/2
2571       if(me.eq.king) &
2572        write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot),&
2573        ', exponents are ',expon,2*expon
2574 !      goto (10,20,30,30,40) ipot
2575       select case(ipot)
2576 !----------------------- LJ potential ---------------------------------
2577        case (1)
2578 !   10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),&
2579          read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),&
2580            (sigma0(i),i=1,ntyp)
2581         if (lprint) then
2582           write (iout,'(/a/)') 'Parameters of the LJ potential:'
2583           write (iout,'(a/)') 'The epsilon array:'
2584           call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
2585           write (iout,'(/a)') 'One-body parameters:'
2586           write (iout,'(a,4x,a)') 'residue','sigma'
2587           write (iout,'(a3,6x,f10.5)') (restyp(i,1),sigma0(i),i=1,ntyp)
2588         endif
2589 !      goto 50
2590 !----------------------- LJK potential --------------------------------
2591        case(2)
2592 !   20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),&
2593          read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),&
2594           (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp)
2595         if (lprint) then
2596           write (iout,'(/a/)') 'Parameters of the LJK potential:'
2597           write (iout,'(a/)') 'The epsilon array:'
2598           call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
2599           write (iout,'(/a)') 'One-body parameters:'
2600           write (iout,'(a,4x,2a)') 'residue','   sigma  ','    r0    '
2601           write (iout,'(a3,6x,2f10.5)') (restyp(i,1),sigma0(i),rr0(i),&
2602                 i=1,ntyp)
2603         endif
2604 !      goto 50
2605 !---------------------- GB or BP potential -----------------------------
2606        case(3:4)
2607 !   30 do i=1,ntyp
2608 !        print *,"I AM in SCELE",scelemode
2609         if (scelemode.eq.0) then
2610         do i=1,ntyp
2611          read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp)
2612         enddo
2613         read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp)
2614         read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp)
2615         read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp)
2616         read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp)
2617         do i=1,ntyp
2618          read (isidep,*,end=117,err=117)(epslip(i,j),j=i,ntyp)
2619         enddo
2620
2621 ! For the GB potential convert sigma'**2 into chi'
2622         if (ipot.eq.4) then
2623           do i=1,ntyp
2624             chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0)
2625           enddo
2626         endif
2627         if (lprint) then
2628           write (iout,'(/a/)') 'Parameters of the BP potential:'
2629           write (iout,'(a/)') 'The epsilon array:'
2630           call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
2631           write (iout,'(/a)') 'One-body parameters:'
2632           write (iout,'(a,4x,4a)') 'residue','   sigma  ','s||/s_|_^2',&
2633                '    chip  ','    alph  '
2634           write (iout,'(a3,6x,4f10.5)') (restyp(i,1),sigma0(i),sigii(i),&
2635                              chip(i),alp(i),i=1,ntyp)
2636         endif
2637        else
2638 !      print *,ntyp,"NTYP"
2639       allocate(icharge(ntyp1))
2640 !      print *,ntyp,icharge(i)
2641       icharge(:)=0
2642       read (isidep,*) (icharge(i),i=1,ntyp)
2643       print *,ntyp,icharge(i)
2644 !      if(.not.allocated(eps)) allocate(eps(-ntyp
2645 !c      write (2,*) "icharge",(icharge(i),i=1,ntyp)
2646        allocate(alphapol(ntyp,ntyp),epshead(ntyp,ntyp),sig0head(ntyp,ntyp))
2647        allocate(sigiso1(ntyp,ntyp),rborn(ntyp,ntyp),sigmap1(ntyp,ntyp))
2648        allocate(sigmap2(ntyp,ntyp),sigiso2(ntyp,ntyp))
2649        allocate(chis(ntyp,ntyp),wquad(ntyp,ntyp),chipp(ntyp,ntyp))
2650        allocate(epsintab(ntyp,ntyp))
2651        allocate(dtail(2,ntyp,ntyp))
2652        allocate(alphasur(4,ntyp,ntyp),alphiso(4,ntyp,ntyp))
2653        allocate(wqdip(2,ntyp,ntyp))
2654        allocate(wstate(4,ntyp,ntyp))
2655        allocate(dhead(2,2,ntyp,ntyp))
2656        allocate(nstate(ntyp,ntyp))
2657        allocate(debaykap(ntyp,ntyp))
2658
2659       if (.not.allocated(sigma)) allocate(sigma(0:ntyp1,0:ntyp1))
2660       if (.not.allocated(chi)) allocate(chi(ntyp1,ntyp1)) !(ntyp,ntyp)
2661
2662       do i=1,ntyp
2663        do j=1,i
2664 !        write (*,*) "Im in ALAB", i, " ", j
2665         read(isidep,*) &
2666        eps(i,j),sigma(i,j),chi(i,j),chi(j,i),chipp(i,j),chipp(j,i), & !6 w tej linii
2667        (alphasur(k,i,j),k=1,4),sigmap1(i,j),sigmap2(i,j), &           !6 w tej linii
2668        chis(i,j),chis(j,i), &                                         !2 w tej linii
2669        nstate(i,j),(wstate(k,i,j),k=1,4), &                           !5 w tej lini - 1 integer pierwszy
2670        dhead(1,1,i,j),dhead(1,2,i,j),dhead(2,1,i,j),dhead(2,2,i,j),&  ! 4 w tej linii
2671        dtail(1,i,j),dtail(2,i,j), &                                   ! 2 w tej lini
2672        epshead(i,j),sig0head(i,j), &                                  ! 2 w tej linii
2673        rborn(i,j),rborn(j,i),(wqdip(k,i,j),k=1,2),wquad(i,j), &       ! 5 w tej linii
2674        alphapol(i,j),alphapol(j,i), &                                 ! 2 w tej linii
2675        (alphiso(k,i,j),k=1,4),sigiso1(i,j),sigiso2(i,j),epsintab(i,j),debaykap(i,j) !8 w tej linii
2676         IF ((LaTeX).and.(i.gt.24)) then
2677         write (2,'(2a4,1h&,14(f8.2,1h&),23(f8.2,1h&))') restyp(i,1),restyp(j,1), &
2678        eps(i,j),sigma(i,j),chi(i,j),chi(j,i),chipp(i,j),chipp(j,i), & !6 w tej linii
2679        (alphasur(k,i,j),k=1,4),sigmap1(i,j),sigmap2(i,j), &           !6 w tej linii
2680        chis(i,j),chis(j,i)                                            !2 w tej linii
2681         endif
2682 !       print *,eps(i,j),sigma(i,j),"SIGMAP",i,j,sigmap1(i,j),sigmap2(j,i)
2683        END DO
2684       END DO
2685       do i=1,ntyp
2686        do j=1,i
2687         IF ((LaTeX).and.(i.gt.24)) then
2688         write (2,'(2a4,1h&,14(f8.2,1h&),23(f8.2,1h&))') restyp(i,1),restyp(j,1), &
2689        dhead(1,1,i,j),dhead(2,1,i,j),&  ! 2 w tej linii
2690        dtail(1,i,j),dtail(2,i,j), &                                   ! 2 w tej lini
2691        epshead(i,j),sig0head(i,j), &                                  ! 2 w tej linii
2692        rborn(i,j),rborn(j,i), &       ! 3 w tej linii
2693        alphapol(i,j),alphapol(j,i), &                                 ! 2 w tej linii
2694        (alphiso(k,i,j),k=1,4),sigiso1(i,j),sigiso2(i,j),epsintab(i,j),debaykap(i,j) !8 w tej linii
2695         endif
2696        END DO
2697       END DO
2698       DO i = 1, ntyp
2699        DO j = i+1, ntyp
2700         eps(i,j) = eps(j,i)
2701         sigma(i,j) = sigma(j,i)
2702         sigmap1(i,j)=sigmap1(j,i)
2703         sigmap2(i,j)=sigmap2(j,i)
2704         sigiso1(i,j)=sigiso1(j,i)
2705         sigiso2(i,j)=sigiso2(j,i)
2706 !        print *,"ATU",sigma(j,i),sigma(i,j),i,j
2707         nstate(i,j) = nstate(j,i)
2708         dtail(1,i,j) = dtail(1,j,i)
2709         dtail(2,i,j) = dtail(2,j,i)
2710         DO k = 1, 4
2711          alphasur(k,i,j) = alphasur(k,j,i)
2712          wstate(k,i,j) = wstate(k,j,i)
2713          alphiso(k,i,j) = alphiso(k,j,i)
2714         END DO
2715
2716         dhead(2,1,i,j) = dhead(1,1,j,i)
2717         dhead(2,2,i,j) = dhead(1,2,j,i)
2718         dhead(1,1,i,j) = dhead(2,1,j,i)
2719         dhead(1,2,i,j) = dhead(2,2,j,i)
2720
2721         epshead(i,j) = epshead(j,i)
2722         sig0head(i,j) = sig0head(j,i)
2723
2724         DO k = 1, 2
2725          wqdip(k,i,j) = wqdip(k,j,i)
2726         END DO
2727
2728         wquad(i,j) = wquad(j,i)
2729         epsintab(i,j) = epsintab(j,i)
2730         debaykap(i,j)=debaykap(j,i)
2731 !        if (epsintab(i,j).ne.1.0) print *,"WHAT?",i,j,epsintab(i,j)
2732        END DO
2733       END DO
2734       endif
2735
2736
2737 !      goto 50
2738 !--------------------- GBV potential -----------------------------------
2739        case(5)
2740 !   40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),&
2741         read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp),&
2742           (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp),&
2743           (chip(i),i=1,ntyp),(alp(i),i=1,ntyp)
2744         if (lprint) then
2745           write (iout,'(/a/)') 'Parameters of the GBV potential:'
2746           write (iout,'(a/)') 'The epsilon array:'
2747           call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
2748           write (iout,'(/a)') 'One-body parameters:'
2749           write (iout,'(a,4x,5a)') 'residue','   sigma  ','    r0    ',&
2750               's||/s_|_^2','    chip  ','    alph  '
2751           write (iout,'(a3,6x,5f10.5)') (restyp(i,1),sigma0(i),rr0(i),&
2752                    sigii(i),chip(i),alp(i),i=1,ntyp)
2753         endif
2754        case default
2755         write(iout,*)"Wrong ipot"
2756 !   50 continue
2757       end select
2758       continue
2759       close (isidep)
2760
2761 !-----------------------------------------------------------------------
2762 ! Calculate the "working" parameters of SC interactions.
2763
2764 !el from module energy - COMMON.INTERACT-------
2765       allocate(aa_aq(ntyp1,ntyp1),bb_aq(ntyp1,ntyp1))
2766       if (.not.allocated(chi)) allocate(chi(ntyp1,ntyp1)) !(ntyp,ntyp)
2767       allocate(aa_lip(ntyp1,ntyp1),bb_lip(ntyp1,ntyp1)) !(ntyp,ntyp)
2768       if (.not.allocated(sigma)) allocate(sigma(0:ntyp1,0:ntyp1))
2769       allocate(r0(ntyp1,ntyp1)) !(0:ntyp1,0:ntyp1)
2770       allocate(acavtub(ntyp1),bcavtub(ntyp1),ccavtub(ntyp1),&
2771         dcavtub(ntyp1))
2772       allocate(sc_aa_tube_par(ntyp1),sc_bb_tube_par(ntyp1),&
2773         tubetranene(ntyp1))
2774       aa_aq(:,:)=0.0D0
2775       bb_aq(:,:)=0.0D0
2776       aa_lip(:,:)=0.0D0
2777       bb_lip(:,:)=0.0D0
2778          if (scelemode.eq.0) then
2779       chi(:,:)=0.0D0
2780       sigma(:,:)=0.0D0
2781       r0(:,:)=0.0D0
2782         endif
2783       acavtub(:)=0.0d0
2784       bcavtub(:)=0.0d0
2785       ccavtub(:)=0.0d0
2786       dcavtub(:)=0.0d0
2787       sc_aa_tube_par(:)=0.0d0
2788       sc_bb_tube_par(:)=0.0d0
2789
2790 !--------------------------------
2791
2792       do i=2,ntyp
2793         do j=1,i-1
2794           eps(i,j)=eps(j,i)
2795           epslip(i,j)=epslip(j,i)
2796         enddo
2797       enddo
2798          if (scelemode.eq.0) then
2799       do i=1,ntyp
2800         do j=i,ntyp
2801           sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2)
2802           sigma(j,i)=sigma(i,j)
2803           rs0(i,j)=dwa16*sigma(i,j)
2804           rs0(j,i)=rs0(i,j)
2805         enddo
2806       enddo
2807       endif
2808       if (lprint) write (iout,'(/a/10x,7a/72(1h-))') &
2809        'Working parameters of the SC interactions:',&
2810        '     a    ','     b    ','   augm   ','  sigma ','   r0   ',&
2811        '  chi1   ','   chi2   '
2812       do i=1,ntyp
2813         do j=i,ntyp
2814           epsij=eps(i,j)
2815           if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
2816             rrij=sigma(i,j)
2817 !            print *,"SIGMA ZLA?",sigma(i,j)
2818           else
2819             rrij=rr0(i)+rr0(j)
2820           endif
2821           r0(i,j)=rrij
2822           r0(j,i)=rrij
2823           rrij=rrij**expon
2824           epsij=eps(i,j)
2825           sigeps=dsign(1.0D0,epsij)
2826           epsij=dabs(epsij)
2827           aa_aq(i,j)=epsij*rrij*rrij
2828 !          print *,"ADASKO",epsij,rrij,expon
2829           bb_aq(i,j)=-sigeps*epsij*rrij
2830           aa_aq(j,i)=aa_aq(i,j)
2831           bb_aq(j,i)=bb_aq(i,j)
2832           epsijlip=epslip(i,j)
2833           sigeps=dsign(1.0D0,epsijlip)
2834           epsijlip=dabs(epsijlip)
2835           aa_lip(i,j)=epsijlip*rrij*rrij
2836           bb_lip(i,j)=-sigeps*epsijlip*rrij
2837           aa_lip(j,i)=aa_lip(i,j)
2838           bb_lip(j,i)=bb_lip(i,j)
2839 !C          write(iout,*) aa_lip
2840           if ((ipot.gt.2).and. (scelemode.eq.0)) then
2841             sigt1sq=sigma0(i)**2
2842             sigt2sq=sigma0(j)**2
2843             sigii1=sigii(i)
2844             sigii2=sigii(j)
2845             ratsig1=sigt2sq/sigt1sq
2846             ratsig2=1.0D0/ratsig1
2847             chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1)
2848             if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2)
2849             rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq)
2850           else
2851             rsum_max=sigma(i,j)
2852           endif
2853 !         if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
2854             sigmaii(i,j)=rsum_max
2855             sigmaii(j,i)=rsum_max
2856 !         else
2857 !           sigmaii(i,j)=r0(i,j)
2858 !           sigmaii(j,i)=r0(i,j)
2859 !         endif
2860 !d        write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max
2861           if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then
2862             r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij
2863             augm(i,j)=epsij*r_augm**(2*expon)
2864 !           augm(i,j)=0.5D0**(2*expon)*aa(i,j)
2865             augm(j,i)=augm(i,j)
2866           else
2867             augm(i,j)=0.0D0
2868             augm(j,i)=0.0D0
2869           endif
2870           if (lprint) then
2871             write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') &
2872             restyp(i,1),restyp(j,1),aa_aq(i,j),bb_aq(i,j),augm(i,j),&
2873             sigma(i,j),r0(i,j),chi(i,j),chi(j,i)
2874           endif
2875         enddo
2876       enddo
2877
2878       allocate(eps_nucl(ntyp_molec(2),ntyp_molec(2)))
2879       allocate(sigma_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp_molec(2),ntyp_molec(2))
2880       allocate(elpp6_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp_molec(2),ntyp_molec(2))
2881       allocate(elpp3_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2882       allocate(elpp63_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp_molec(2),ntyp_molec(2))
2883       allocate(elpp32_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2884       allocate(chi_nucl(ntyp_molec(2),ntyp_molec(2)),chip_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp_molec(2),ntyp_molec(2))
2885       allocate(ael3_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2886       allocate(ael6_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2887       allocate(ael32_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2888       allocate(ael63_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2889       allocate(aa_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2890       allocate(bb_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2891       allocate(r0_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp,2)
2892       allocate(sigmaii_nucl(ntyp_molec(2),ntyp_molec(2))) !(ntyp_molec(2),ntyp_molec(2))
2893       allocate(eps_scp_nucl(ntyp_molec(2)),rscp_nucl(ntyp_molec(2))) !(ntyp,2)
2894
2895 !      augm(:,:)=0.0D0
2896 !      chip(:)=0.0D0
2897 !      alp(:)=0.0D0
2898 !      sigma0(:)=0.0D0
2899 !      sigii(:)=0.0D0
2900 !      rr0(:)=0.0D0
2901
2902       read (isidep_nucl,*) ipot_nucl
2903 !      print *,"TU?!",ipot_nucl
2904       if (ipot_nucl.eq.1) then
2905         do i=1,ntyp_molec(2)
2906           do j=i,ntyp_molec(2)
2907             read (isidep_nucl,*) eps_nucl(i,j),sigma_nucl(i,j),elpp6_nucl(i,j),&
2908             elpp3_nucl(i,j), elpp63_nucl(i,j),elpp32_nucl(i,j)
2909           enddo
2910         enddo
2911       else
2912         do i=1,ntyp_molec(2)
2913           do j=i,ntyp_molec(2)
2914             read (isidep_nucl,*) eps_nucl(i,j),sigma_nucl(i,j),chi_nucl(i,j),&
2915                chi_nucl(j,i),chip_nucl(i,j),chip_nucl(j,i),&
2916                elpp6_nucl(i,j),elpp3_nucl(i,j),elpp63_nucl(i,j),elpp32_nucl(i,j)
2917           enddo
2918         enddo
2919       endif
2920 !      rpp(1,1)=2**(1.0/6.0)*5.16158
2921       do i=1,ntyp_molec(2)
2922         do j=i,ntyp_molec(2)
2923           rrij=sigma_nucl(i,j)
2924           r0_nucl(i,j)=rrij
2925           r0_nucl(j,i)=rrij
2926           rrij=rrij**expon
2927           epsij=4*eps_nucl(i,j)
2928           sigeps=dsign(1.0D0,epsij)
2929           epsij=dabs(epsij)
2930           aa_nucl(i,j)=epsij*rrij*rrij
2931           bb_nucl(i,j)=-sigeps*epsij*rrij
2932           ael3_nucl(i,j)=elpp3_nucl(i,j)*dsqrt(rrij)
2933           ael6_nucl(i,j)=elpp6_nucl(i,j)*rrij
2934           ael63_nucl(i,j)=elpp63_nucl(i,j)*rrij
2935           ael32_nucl(i,j)=elpp32_nucl(i,j)*rrij
2936           sigmaii_nucl(i,j)=sigma_nucl(i,j)/sqrt(1-(chi_nucl(i,j)+chi_nucl(j,i)- &
2937          2*chi_nucl(i,j)*chi_nucl(j,i))/(1-chi_nucl(i,j)*chi_nucl(j,i)))
2938         enddo
2939         do j=1,i-1
2940           aa_nucl(i,j)=aa_nucl(j,i)
2941           bb_nucl(i,j)=bb_nucl(j,i)
2942           ael3_nucl(i,j)=ael3_nucl(j,i)
2943           ael6_nucl(i,j)=ael6_nucl(j,i)
2944           ael63_nucl(i,j)=ael63_nucl(j,i)
2945           ael32_nucl(i,j)=ael32_nucl(j,i)
2946           elpp3_nucl(i,j)=elpp3_nucl(j,i)
2947           elpp6_nucl(i,j)=elpp6_nucl(j,i)
2948           elpp63_nucl(i,j)=elpp63_nucl(j,i)
2949           elpp32_nucl(i,j)=elpp32_nucl(j,i)
2950           eps_nucl(i,j)=eps_nucl(j,i)
2951           sigma_nucl(i,j)=sigma_nucl(j,i)
2952           sigmaii_nucl(i,j)=sigmaii_nucl(j,i)
2953         enddo
2954       enddo
2955
2956       write(iout,*) "tube param"
2957       read(itube,*) epspeptube,sigmapeptube,acavtubpep,bcavtubpep, &
2958       ccavtubpep,dcavtubpep,tubetranenepep
2959       sigmapeptube=sigmapeptube**6
2960       sigeps=dsign(1.0D0,epspeptube)
2961       epspeptube=dabs(epspeptube)
2962       pep_aa_tube=4.0d0*epspeptube*sigmapeptube**2
2963       pep_bb_tube=-sigeps*4.0d0*epspeptube*sigmapeptube
2964       write(iout,*) pep_aa_tube,pep_bb_tube,tubetranenepep
2965       do i=1,ntyp
2966        read(itube,*) epssctube,sigmasctube,acavtub(i),bcavtub(i), &
2967       ccavtub(i),dcavtub(i),tubetranene(i)
2968        sigmasctube=sigmasctube**6
2969        sigeps=dsign(1.0D0,epssctube)
2970        epssctube=dabs(epssctube)
2971        sc_aa_tube_par(i)=4.0d0*epssctube*sigmasctube**2
2972        sc_bb_tube_par(i)=-sigeps*4.0d0*epssctube*sigmasctube
2973       write(iout,*) sc_aa_tube_par(i), sc_bb_tube_par(i),tubetranene(i)
2974       enddo
2975 !-----------------READING SC BASE POTENTIALS-----------------------------
2976       allocate(eps_scbase(ntyp_molec(1),ntyp_molec(2)))
2977       allocate(sigma_scbase(ntyp_molec(1),ntyp_molec(2)))
2978       allocate(chi_scbase(ntyp_molec(1),ntyp_molec(2),2))
2979       allocate(chipp_scbase(ntyp_molec(1),ntyp_molec(2),2))
2980       allocate(alphasur_scbase(4,ntyp_molec(1),ntyp_molec(2)))
2981       allocate(sigmap1_scbase(ntyp_molec(1),ntyp_molec(2)))
2982       allocate(sigmap2_scbase(ntyp_molec(1),ntyp_molec(2)))
2983       allocate(chis_scbase(ntyp_molec(1),ntyp_molec(2),2))
2984       allocate(dhead_scbasei(ntyp_molec(1),ntyp_molec(2)))
2985       allocate(dhead_scbasej(ntyp_molec(1),ntyp_molec(2)))
2986       allocate(rborn_scbasei(ntyp_molec(1),ntyp_molec(2)))
2987       allocate(rborn_scbasej(ntyp_molec(1),ntyp_molec(2)))
2988       allocate(wdipdip_scbase(3,ntyp_molec(1),ntyp_molec(2)))
2989       allocate(wqdip_scbase(2,ntyp_molec(1),ntyp_molec(2)))
2990       allocate(alphapol_scbase(ntyp_molec(1),ntyp_molec(2)))
2991       allocate(epsintab_scbase(ntyp_molec(1),ntyp_molec(2)))
2992
2993
2994       do i=1,ntyp_molec(1)
2995        do j=1,ntyp_molec(2)-1 ! without U then we will take T for U
2996         write (*,*) "Im in ", i, " ", j
2997         read(isidep_scbase,*) &
2998         eps_scbase(i,j),sigma_scbase(i,j),chi_scbase(i,j,1),&
2999         chi_scbase(i,j,2),chipp_scbase(i,j,1),chipp_scbase(i,j,2)
3000          write(*,*) "eps",eps_scbase(i,j)
3001         read(isidep_scbase,*) &
3002        (alphasur_scbase(k,i,j),k=1,4),sigmap1_scbase(i,j),sigmap2_scbase(i,j), &
3003        chis_scbase(i,j,1),chis_scbase(i,j,2)
3004         read(isidep_scbase,*) &
3005        dhead_scbasei(i,j), &
3006        dhead_scbasej(i,j), &
3007        rborn_scbasei(i,j),rborn_scbasej(i,j)
3008         read(isidep_scbase,*) &
3009        (wdipdip_scbase(k,i,j),k=1,3), &
3010        (wqdip_scbase(k,i,j),k=1,2)
3011         read(isidep_scbase,*) &
3012        alphapol_scbase(i,j), &
3013        epsintab_scbase(i,j)
3014        END DO
3015       END DO
3016       allocate(aa_scbase(ntyp_molec(1),ntyp_molec(2)))
3017       allocate(bb_scbase(ntyp_molec(1),ntyp_molec(2)))
3018
3019       do i=1,ntyp_molec(1)
3020        do j=1,ntyp_molec(2)-1
3021           epsij=eps_scbase(i,j)
3022           rrij=sigma_scbase(i,j)
3023 !          r0(i,j)=rrij
3024 !          r0(j,i)=rrij
3025           rrij=rrij**expon
3026 !          epsij=eps(i,j)
3027           sigeps=dsign(1.0D0,epsij)
3028           epsij=dabs(epsij)
3029           aa_scbase(i,j)=epsij*rrij*rrij
3030           bb_scbase(i,j)=-sigeps*epsij*rrij
3031         enddo
3032        enddo
3033 !-----------------READING PEP BASE POTENTIALS-------------------
3034       allocate(eps_pepbase(ntyp_molec(2)))
3035       allocate(sigma_pepbase(ntyp_molec(2)))
3036       allocate(chi_pepbase(ntyp_molec(2),2))
3037       allocate(chipp_pepbase(ntyp_molec(2),2))
3038       allocate(alphasur_pepbase(4,ntyp_molec(2)))
3039       allocate(sigmap1_pepbase(ntyp_molec(2)))
3040       allocate(sigmap2_pepbase(ntyp_molec(2)))
3041       allocate(chis_pepbase(ntyp_molec(2),2))
3042       allocate(wdipdip_pepbase(3,ntyp_molec(2)))
3043
3044
3045        do j=1,ntyp_molec(2)-1 ! without U then we will take T for U
3046         write (*,*) "Im in ", i, " ", j
3047         read(isidep_pepbase,*) &
3048         eps_pepbase(j),sigma_pepbase(j),chi_pepbase(j,1),&
3049         chi_pepbase(j,2),chipp_pepbase(j,1),chipp_pepbase(j,2)
3050          write(*,*) "eps",eps_pepbase(j)
3051         read(isidep_pepbase,*) &
3052        (alphasur_pepbase(k,j),k=1,4),sigmap1_pepbase(j),sigmap2_pepbase(j), &
3053        chis_pepbase(j,1),chis_pepbase(j,2)
3054         read(isidep_pepbase,*) &
3055        (wdipdip_pepbase(k,j),k=1,3)
3056        END DO
3057       allocate(aa_pepbase(ntyp_molec(2)))
3058       allocate(bb_pepbase(ntyp_molec(2)))
3059
3060        do j=1,ntyp_molec(2)-1
3061           epsij=eps_pepbase(j)
3062           rrij=sigma_pepbase(j)
3063 !          r0(i,j)=rrij
3064 !          r0(j,i)=rrij
3065           rrij=rrij**expon
3066 !          epsij=eps(i,j)
3067           sigeps=dsign(1.0D0,epsij)
3068           epsij=dabs(epsij)
3069           aa_pepbase(j)=epsij*rrij*rrij
3070           bb_pepbase(j)=-sigeps*epsij*rrij
3071         enddo
3072 !--------------READING SC PHOSPHATE-------------------------------------
3073       allocate(eps_scpho(ntyp_molec(1)))
3074       allocate(sigma_scpho(ntyp_molec(1)))
3075       allocate(chi_scpho(ntyp_molec(1),2))
3076       allocate(chipp_scpho(ntyp_molec(1),2))
3077       allocate(alphasur_scpho(4,ntyp_molec(1)))
3078       allocate(sigmap1_scpho(ntyp_molec(1)))
3079       allocate(sigmap2_scpho(ntyp_molec(1)))
3080       allocate(chis_scpho(ntyp_molec(1),2))
3081       allocate(wqq_scpho(ntyp_molec(1)))
3082       allocate(wqdip_scpho(2,ntyp_molec(1)))
3083       allocate(alphapol_scpho(ntyp_molec(1)))
3084       allocate(epsintab_scpho(ntyp_molec(1)))
3085       allocate(dhead_scphoi(ntyp_molec(1)))
3086       allocate(rborn_scphoi(ntyp_molec(1)))
3087       allocate(rborn_scphoj(ntyp_molec(1)))
3088       allocate(alphi_scpho(ntyp_molec(1)))
3089
3090
3091 !      j=1
3092        do j=1,ntyp_molec(1) ! without U then we will take T for U
3093         write (*,*) "Im in scpho ", i, " ", j
3094         read(isidep_scpho,*) &
3095         eps_scpho(j),sigma_scpho(j),chi_scpho(j,1),&
3096         chi_scpho(j,2),chipp_scpho(j,1),chipp_scpho(j,2)
3097          write(*,*) "eps",eps_scpho(j)
3098         read(isidep_scpho,*) &
3099        (alphasur_scpho(k,j),k=1,4),sigmap1_scpho(j),sigmap2_scpho(j), &
3100        chis_scpho(j,1),chis_scpho(j,2)
3101         read(isidep_scpho,*) &
3102        (wqdip_scpho(k,j),k=1,2),wqq_scpho(j),dhead_scphoi(j)
3103         read(isidep_scpho,*) &
3104          epsintab_scpho(j),alphapol_scpho(j),rborn_scphoi(j),rborn_scphoj(j), &
3105          alphi_scpho(j)
3106
3107        END DO
3108       allocate(aa_scpho(ntyp_molec(1)))
3109       allocate(bb_scpho(ntyp_molec(1)))
3110
3111        do j=1,ntyp_molec(1)
3112           epsij=eps_scpho(j)
3113           rrij=sigma_scpho(j)
3114 !          r0(i,j)=rrij
3115 !          r0(j,i)=rrij
3116           rrij=rrij**expon
3117 !          epsij=eps(i,j)
3118           sigeps=dsign(1.0D0,epsij)
3119           epsij=dabs(epsij)
3120           aa_scpho(j)=epsij*rrij*rrij
3121           bb_scpho(j)=-sigeps*epsij*rrij
3122         enddo
3123
3124
3125         read(isidep_peppho,*) &
3126         eps_peppho,sigma_peppho
3127         read(isidep_peppho,*) &
3128        (alphasur_peppho(k),k=1,4),sigmap1_peppho,sigmap2_peppho
3129         read(isidep_peppho,*) &
3130        (wqdip_peppho(k),k=1,2)
3131
3132           epsij=eps_peppho
3133           rrij=sigma_peppho
3134 !          r0(i,j)=rrij
3135 !          r0(j,i)=rrij
3136           rrij=rrij**expon
3137 !          epsij=eps(i,j)
3138           sigeps=dsign(1.0D0,epsij)
3139           epsij=dabs(epsij)
3140           aa_peppho=epsij*rrij*rrij
3141           bb_peppho=-sigeps*epsij*rrij
3142
3143
3144       allocate(aad(ntyp,2),bad(ntyp,2)) !(ntyp,2)
3145       bad(:,:)=0.0D0
3146
3147 #ifdef OLDSCP
3148 !
3149 ! Define the SC-p interaction constants (hard-coded; old style)
3150 !
3151       do i=1,ntyp
3152 ! "Soft" SC-p repulsion (causes helices to be too flat, but facilitates
3153 ! helix formation)
3154 !       aad(i,1)=0.3D0*4.0D0**12
3155 ! Following line for constants currently implemented
3156 ! "Hard" SC-p repulsion (gives correct turn spacing in helices)
3157         aad(i,1)=1.5D0*4.0D0**12
3158 !       aad(i,1)=0.17D0*5.6D0**12
3159         aad(i,2)=aad(i,1)
3160 ! "Soft" SC-p repulsion
3161         bad(i,1)=0.0D0
3162 ! Following line for constants currently implemented
3163 !       aad(i,1)=0.3D0*4.0D0**6
3164 ! "Hard" SC-p repulsion
3165         bad(i,1)=3.0D0*4.0D0**6
3166 !       bad(i,1)=-2.0D0*0.17D0*5.6D0**6
3167         bad(i,2)=bad(i,1)
3168 !       aad(i,1)=0.0D0
3169 !       aad(i,2)=0.0D0
3170 !       bad(i,1)=1228.8D0
3171 !       bad(i,2)=1228.8D0
3172       enddo
3173 #else
3174 !
3175 ! 8/9/01 Read the SC-p interaction constants from file
3176 !
3177       do i=1,ntyp
3178         read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2)
3179       enddo
3180       do i=1,ntyp
3181         aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12
3182         aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12
3183         bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6
3184         bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6
3185       enddo
3186 !      lprint=.true.
3187       if (lprint) then
3188         write (iout,*) "Parameters of SC-p interactions:"
3189         do i=1,ntyp
3190           write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1),&
3191            eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2)
3192         enddo
3193       endif
3194 !      lprint=.false.
3195 #endif
3196       allocate(aad_nucl(ntyp_molec(2)),bad_nucl(ntyp_molec(2))) !(ntyp,2)
3197
3198       do i=1,ntyp_molec(2)
3199         read (iscpp_nucl,*,end=118,err=118) eps_scp_nucl(i),rscp_nucl(i)
3200       enddo
3201       do i=1,ntyp_molec(2)
3202         aad_nucl(i)=dabs(eps_scp_nucl(i))*rscp_nucl(i)**12
3203         bad_nucl(i)=-2*eps_scp_nucl(i)*rscp_nucl(i)**6
3204       enddo
3205       r0pp=1.12246204830937298142*5.16158
3206       epspp=4.95713/4
3207       AEES=108.661
3208       BEES=0.433246
3209
3210 !
3211 ! Define the constants of the disulfide bridge
3212 !
3213       ebr=-5.50D0
3214 !
3215 ! Old arbitrary potential - commented out.
3216 !
3217 !      dbr= 4.20D0
3218 !      fbr= 3.30D0
3219 !
3220 ! Constants of the disulfide-bond potential determined based on the RHF/6-31G**
3221 ! energy surface of diethyl disulfide.
3222 ! A. Liwo and U. Kozlowska, 11/24/03
3223 !
3224       D0CM = 3.78d0
3225       AKCM = 15.1d0
3226       AKTH = 11.0d0
3227       AKCT = 12.0d0
3228       V1SS =-1.08d0
3229       V2SS = 7.61d0
3230       V3SS = 13.7d0
3231 !      akcm=0.0d0
3232 !      akth=0.0d0
3233 !      akct=0.0d0
3234 !      v1ss=0.0d0
3235 !      v2ss=0.0d0
3236 !      v3ss=0.0d0
3237
3238 ! Ions by Aga
3239
3240        allocate(alphapolcat(ntyp,ntyp),epsheadcat(ntyp,ntyp),sig0headcat(ntyp,ntyp))
3241        allocate(sigiso1cat(ntyp,ntyp),rborncat(ntyp,ntyp),sigmap1cat(ntyp,ntyp))
3242        allocate(sigmap2cat(ntyp,ntyp),sigiso2cat(ntyp,ntyp))
3243        allocate(chiscat(ntyp,ntyp),wquadcat(ntyp,ntyp),chippcat(ntyp,ntyp))
3244        allocate(epsintabcat(ntyp,ntyp))
3245        allocate(dtailcat(2,ntyp,ntyp))
3246        allocate(alphasurcat(4,ntyp,ntyp),alphisocat(4,ntyp,ntyp))
3247        allocate(wqdipcat(2,ntyp,ntyp))
3248        allocate(wstatecat(4,ntyp,ntyp))
3249        allocate(dheadcat(2,2,ntyp,ntyp))
3250        allocate(nstatecat(ntyp,ntyp))
3251        allocate(debaykapcat(ntyp,ntyp))
3252
3253
3254       if (.not.allocated(sigmacat)) allocate(sigmacat(0:ntyp1,0:ntyp1))
3255       if (.not.allocated(chicat)) allocate(chicat(ntyp1,ntyp1)) !(ntyp,ntyp)
3256
3257 ! i to SC, j to jon, isideocat - nazwa pliku z ktorego czytam parametry
3258        if (oldion.eq.0) then
3259             do i=1,ntyp_molec(5)
3260              read(iion,*) msc(i,5),restok(i,5)
3261              print *,msc(i,5),restok(i,5)
3262             enddo
3263             ip(5)=0.2
3264
3265       do i=1,ntyp
3266        do j=1,ntyp_molec(5)
3267 !        write (*,*) "Im in ALAB", i, " ", j
3268         read(iion,*) &
3269        epscat(i,j),sigmacat(i,j),chicat(i,j),chicat(j,i),chippcat(i,j),chippcat(j,i), &
3270        (alphasurcat(k,i,j),k=1,4),sigmap1cat(i,j),sigmap2cat(i,j),&
3271        chiscat(i,j),chiscat(j,i), &
3272        nstatecat(i,j),(wstatecat(k,i,j),k=1,4), &                           !5 w tej lini - 1 integer pierwszy
3273        dheadcat(1,1,i,j),dheadcat(1,2,i,j),dheadcat(2,1,i,j),dheadcat(2,2,i,j),&
3274        dtailcat(1,i,j),dtailcat(2,i,j), &
3275        epsheadcat(i,j),sig0headcat(i,j), &
3276 !wdipcat = w1 , w2
3277        rborncat(i,j),rborncat(j,i),(wqdipcat(k,i,j),k=1,2), &
3278        alphapolcat(i,j),alphapolcat(j,i), &
3279        (alphisocat(k,i,j),k=1,4),sigiso1cat(i,j),sigiso2cat(i,j),epsintabcat(i,j),debaykapcat(i,j)
3280 !       print *,eps(i,j),sigma(i,j),"SIGMAP",i,j,sigmap1(i,j),sigmap2(j,i)
3281        END DO
3282       END DO
3283       endif
3284
3285
3286       if(me.eq.king) then
3287       write (iout,'(/a)') "Disulfide bridge parameters:"
3288       write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
3289       write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
3290       write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
3291       write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,&
3292         ' v3ss:',v3ss
3293       endif
3294       if (shield_mode.gt.0) then
3295       pi=4.0D0*datan(1.0D0)
3296 !C VSolvSphere the volume of solving sphere
3297       print *,pi,"pi"
3298 !C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
3299 !C there will be no distinction between proline peptide group and normal peptide
3300 !C group in case of shielding parameters
3301       VSolvSphere=4.0/3.0*pi*(4.50d0)**3
3302       VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(4.50/2.0)**3
3303       write (iout,*) VSolvSphere,VSolvSphere_div
3304 !C long axis of side chain
3305       do i=1,ntyp
3306       long_r_sidechain(i)=vbldsc0(1,i)
3307 !      if (scelemode.eq.0) then
3308       short_r_sidechain(i)=sigma(i,i)/sqrt(2.0)
3309       if (short_r_sidechain(i).eq.0.0) short_r_sidechain(i)=0.2
3310 !      else
3311 !      short_r_sidechain(i)=sigma(i,i)
3312 !      endif
3313       write(iout,*) "parame for long and short axis",i,vbldsc0(1,i),&
3314          sigma0(i)
3315       enddo
3316       buff_shield=1.0d0
3317       endif
3318
3319       return
3320   111 write (iout,*) "Error reading bending energy parameters."
3321       goto 999
3322   112 write (iout,*) "Error reading rotamer energy parameters."
3323       goto 999
3324   113 write (iout,*) "Error reading torsional energy parameters."
3325       goto 999
3326   114 write (iout,*) "Error reading double torsional energy parameters."
3327       goto 999
3328   115 write (iout,*) &
3329         "Error reading cumulant (multibody energy) parameters."
3330       goto 999
3331   116 write (iout,*) "Error reading electrostatic energy parameters."
3332       goto 999
3333   117 write (iout,*) "Error reading side chain interaction parameters."
3334       goto 999
3335   118 write (iout,*) "Error reading SCp interaction parameters."
3336       goto 999
3337   119 write (iout,*) "Error reading SCCOR parameters"
3338       go to 999
3339   121 write (iout,*) "Error in Czybyshev parameters"
3340   999 continue
3341 #ifdef MPI
3342       call MPI_Finalize(Ierror)
3343 #endif
3344       stop
3345       return
3346       end subroutine parmread
3347 #endif
3348 !-----------------------------------------------------------------------------
3349 ! printmat.f
3350 !-----------------------------------------------------------------------------
3351       subroutine printmat(ldim,m,n,iout,key,a)
3352
3353       integer :: n,ldim
3354       character(len=3),dimension(n) :: key
3355       real(kind=8),dimension(ldim,n) :: a
3356 !el local variables
3357       integer :: i,j,k,m,iout,nlim
3358
3359       do 1 i=1,n,8
3360       nlim=min0(i+7,n)
3361       write (iout,1000) (key(k),k=i,nlim)
3362       write (iout,1020)
3363  1000 format (/5x,8(6x,a3))
3364  1020 format (/80(1h-)/)
3365       do 2 j=1,n
3366       write (iout,1010) key(j),(a(j,k),k=i,nlim)
3367     2 continue
3368     1 continue
3369  1010 format (a3,2x,8(f9.4))
3370       return
3371       end subroutine printmat
3372 !-----------------------------------------------------------------------------
3373 ! readpdb.F
3374 !-----------------------------------------------------------------------------
3375       subroutine readpdb
3376 ! Read the PDB file and convert the peptide geometry into virtual-chain
3377 ! geometry.
3378       use geometry_data
3379       use energy_data, only: itype,istype
3380       use control_data
3381       use compare_data
3382       use MPI_data
3383 !      use control, only: rescode,sugarcode
3384 !      implicit real*8 (a-h,o-z)
3385 !      include 'DIMENSIONS'
3386 !      include 'COMMON.LOCAL'
3387 !      include 'COMMON.VAR'
3388 !      include 'COMMON.CHAIN'
3389 !      include 'COMMON.INTERACT'
3390 !      include 'COMMON.IOUNITS'
3391 !      include 'COMMON.GEO'
3392 !      include 'COMMON.NAMES'
3393 !      include 'COMMON.CONTROL'
3394 !      include 'COMMON.DISTFIT'
3395 !      include 'COMMON.SETUP'
3396       integer :: i,j,ibeg,ishift1,ires,iii,ires_old,ishift,k!,ity!,&
3397 !        ishift_pdb
3398       logical :: lprn=.true.,fail
3399       real(kind=8),dimension(3) :: e1,e2,e3
3400       real(kind=8) :: dcj,efree_temp
3401       character(len=3) :: seq,res,res2
3402       character(len=5) :: atom
3403       character(len=80) :: card
3404       real(kind=8),dimension(3,20) :: sccor
3405       integer :: kkk,lll,icha,kupa,molecule,counter,seqalingbegin       !rescode,
3406       integer :: isugar,molecprev,firstion
3407       character*1 :: sugar
3408       real(kind=8) :: cou
3409       real(kind=8),dimension(3) :: ccc
3410 !el local varables
3411       integer,dimension(2,maxres/3) :: hfrag_alloc
3412       integer,dimension(4,maxres/3) :: bfrag_alloc
3413       real(kind=8),dimension(3,maxres2+2,maxperm) :: cref_alloc !(3,maxres2+2,maxperm)
3414       real(kind=8),dimension(:,:), allocatable  :: c_temporary
3415       integer,dimension(:,:) , allocatable  :: itype_temporary
3416       integer,dimension(:),allocatable :: istype_temp
3417       efree_temp=0.0d0
3418       ibeg=1
3419       ishift1=0
3420       ishift=0
3421       molecule=1
3422       counter=0
3423 !      write (2,*) "UNRES_PDB",unres_pdb
3424       ires=0
3425       ires_old=0
3426 #ifdef WHAM_RUN
3427       do i=1,nres
3428        do j=1,5
3429         itype(i,j)=0
3430        enddo
3431       enddo
3432 #endif
3433       nres=0
3434       iii=0
3435       lsecondary=.false.
3436       nhfrag=0
3437       nbfrag=0
3438       do j=1,5
3439        nres_molec(j)=0
3440       enddo
3441
3442
3443 !-----------------------------
3444       allocate(hfrag(2,maxres/3)) !(2,maxres/3)
3445       allocate(bfrag(4,maxres/3)) !(4,maxres/3)
3446       if(.not. allocated(istype)) allocate(istype(maxres))
3447       do i=1,100000
3448         read (ipdbin,'(a80)',end=10) card
3449        write (iout,'(a)') card
3450         if (card(:5).eq.'HELIX') then
3451           nhfrag=nhfrag+1
3452           lsecondary=.true.
3453           read(card(22:25),*) hfrag(1,nhfrag)
3454           read(card(34:37),*) hfrag(2,nhfrag)
3455         endif
3456         if (card(:5).eq.'SHEET') then
3457           nbfrag=nbfrag+1
3458           lsecondary=.true.
3459           read(card(24:26),*) bfrag(1,nbfrag)
3460           read(card(35:37),*) bfrag(2,nbfrag)
3461 !rc----------------------------------------
3462 !rc  to be corrected !!!
3463           bfrag(3,nbfrag)=bfrag(1,nbfrag)
3464           bfrag(4,nbfrag)=bfrag(2,nbfrag)
3465 !rc----------------------------------------
3466         endif
3467         if (card(:3).eq.'END') then
3468           goto 10
3469         else if (card(:3).eq.'TER') then
3470 ! End current chain
3471           ires_old=ires+2
3472           ishift=ishift+1
3473           ishift1=ishift1+1
3474           itype(ires_old,molecule)=ntyp1_molec(molecule)
3475           itype(ires_old-1,molecule)=ntyp1_molec(molecule)
3476           nres_molec(molecule)=nres_molec(molecule)+2
3477           ibeg=2
3478 !          write (iout,*) "Chain ended",ires,ishift,ires_old
3479           if (unres_pdb) then
3480             do j=1,3
3481               dc(j,ires)=sccor(j,iii)
3482             enddo
3483           else
3484             call sccenter(ires,iii,sccor)
3485 !          iii=0
3486           endif
3487           iii=0
3488         endif
3489 ! Read free energy
3490         if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
3491 ! Fish out the ATOM cards.
3492 !        write(iout,*) 'card',card(1:20)
3493 !        print *,"ATU ",card(1:6), CARD(3:6)
3494 !        print *,card
3495         if (index(card(1:4),'ATOM').gt.0) then
3496           read (card(12:16),*) atom
3497 !          write (iout,*) "! ",atom," !",ires
3498 !          if (atom.eq.'CA' .or. atom.eq.'CH3') then
3499           read (card(23:26),*) ires
3500           read (card(18:20),'(a3)') res
3501 !          write (iout,*) "ires",ires,ires-ishift+ishift1,
3502 !     &      " ires_old",ires_old
3503 !          write (iout,*) "ishift",ishift," ishift1",ishift1
3504 !          write (iout,*) "IRES",ires-ishift+ishift1,ires_old
3505           if (ires-ishift+ishift1.ne.ires_old) then
3506 ! Calculate the CM of the preceding residue.
3507 !            if (ibeg.eq.0) call sccenter(ires,iii,sccor)
3508             if (ibeg.eq.0) then
3509 !              write (iout,*) "Calculating sidechain center iii",iii
3510               if (unres_pdb) then
3511                 do j=1,3
3512                   dc(j,ires+ishift1-ishift-1)=sccor(j,iii)
3513                 enddo
3514               else
3515                 call sccenter(ires_old,iii,sccor)
3516               endif !unres_pdb
3517               iii=0
3518             endif !ind_pdb
3519 ! Start new residue.
3520             if (res.eq.'Cl-' .or. res.eq.'Na+') then
3521               ires=ires_old
3522               cycle
3523             else if (ibeg.eq.1) then
3524               write (iout,*) "BEG ires",ires
3525               ishift=ires-1
3526               if (res.ne.'GLY' .and. res.ne. 'ACE') then
3527                 ishift=ishift-1
3528                 itype(1,1)=ntyp1
3529                 nres_molec(molecule)=nres_molec(molecule)+1
3530               endif ! Gly
3531               ires=ires-ishift+ishift1
3532               ires_old=ires
3533 !              write (iout,*) "ishift",ishift," ires",ires,&
3534 !               " ires_old",ires_old
3535               ibeg=0
3536             else if (ibeg.eq.2) then
3537 ! Start a new chain
3538               ishift=-ires_old+ires-1 !!!!!
3539               ishift1=ishift1-1    !!!!!
3540 !              write (iout,*) "New chain started",ires,ishift,ishift1,"!"
3541               ires=ires-ishift+ishift1
3542 !              print *,ires,ishift,ishift1
3543               ires_old=ires
3544               ibeg=0
3545             else
3546               ishift=ishift-(ires-ishift+ishift1-ires_old-1)
3547               ires=ires-ishift+ishift1
3548               ires_old=ires
3549             endif ! Na Cl
3550 !            print *,'atom',ires,atom
3551             if (res.eq.'ACE' .or. res.eq.'NHE') then
3552               itype(ires,1)=10
3553             else
3554              if (atom.eq.'CA  '.or.atom.eq.'N   ') then
3555              molecule=1
3556               itype(ires,molecule)=rescode(ires,res,0,molecule)
3557               firstion=0
3558 !              nres_molec(molecule)=nres_molec(molecule)+1
3559             else
3560              molecule=2
3561              res2=res(2:3)
3562               itype(ires,molecule)=rescode(ires,res2,0,molecule)
3563 !              nres_molec(molecule)=nres_molec(molecule)+1
3564              read (card(19:19),'(a1)') sugar
3565              isugar=sugarcode(sugar,ires)
3566 !            if (ibeg.eq.1) then
3567 !              istype(1)=isugar
3568 !            else
3569               istype(ires)=isugar
3570 !              print *,"ires=",ires,istype(ires)
3571 !            endif
3572
3573             endif ! atom.eq.CA
3574             endif !ACE
3575           else
3576             ires=ires-ishift+ishift1
3577           endif !ires_old
3578 !          write (iout,*) "ires_old",ires_old," ires",ires
3579           if (card(27:27).eq."A" .or. card(27:27).eq."B") then
3580 !            ishift1=ishift1+1
3581           endif
3582 !          write (2,*) "ires",ires," res ",res!," ity"!,ity
3583           if (atom.eq.'CA' .or. atom.eq.'CH3' .or. &
3584              res.eq.'NHE'.and.atom(:2).eq.'HN') then
3585             read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
3586 !              print *,ires,ishift,ishift1
3587 !            write (iout,*) "backbone ",atom
3588 #ifdef DEBUG
3589             write (iout,'(2i3,2x,a,3f8.3)') &
3590             ires,itype(ires,1),res,(c(j,ires),j=1,3)
3591 #endif
3592             iii=iii+1
3593               nres_molec(molecule)=nres_molec(molecule)+1
3594             do j=1,3
3595               sccor(j,iii)=c(j,ires)
3596             enddo
3597           else if (.not.unres_pdb .and. (atom.eq."C1'" .or. &
3598                atom.eq."C2'" .or. atom.eq."C3'" &
3599                .or. atom.eq."C4'" .or. atom.eq."O4'")) then
3600             read(card(31:54),'(3f8.3)') (ccc(j),j=1,3)
3601 !c            write (2,'(i5,3f10.5)') ires,(ccc(j),j=1,3)
3602 !              print *,ires,ishift,ishift1
3603             counter=counter+1
3604 !            iii=iii+1
3605 !            do j=1,3
3606 !              sccor(j,iii)=c(j,ires)
3607 !            enddo
3608             do j=1,3
3609               c(j,ires)=c(j,ires)+ccc(j)/5.0
3610             enddo
3611              print *,counter,molecule
3612              if (counter.eq.5) then
3613 !            iii=iii+1
3614               nres_molec(molecule)=nres_molec(molecule)+1
3615               firstion=0
3616 !            do j=1,3
3617 !              sccor(j,iii)=c(j,ires)
3618 !            enddo
3619              counter=0
3620            endif
3621 !            print *, "ATOM",atom(1:3)
3622           else if (atom.eq."C5'") then
3623              read (card(19:19),'(a1)') sugar
3624              isugar=sugarcode(sugar,ires)
3625             if (ibeg.eq.1) then
3626               istype(1)=isugar
3627             else
3628               istype(ires)=isugar
3629 !              print *,ires,istype(ires)
3630             endif
3631             if (unres_pdb) then
3632               molecule=2
3633 !              print *,"nres_molec(molecule)",nres_molec(molecule),ires
3634               read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
3635               nres_molec(molecule)=nres_molec(molecule)+1
3636               print *,"nres_molec(molecule)",nres_molec(molecule),ires
3637
3638             else
3639               iii=iii+1
3640               read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
3641             endif
3642           else if ((atom.eq."C1'").and.unres_pdb) then
3643               iii=iii+1
3644               read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
3645 !            write (*,*) card(23:27),ires,itype(ires,1)
3646           else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. &
3647                    atom.ne.'N' .and. atom.ne.'C' .and. &
3648                    atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. &
3649                    atom.ne.'OXT' .and. atom(:2).ne.'3H' &
3650                    .and. atom.ne.'P  '.and. &
3651                   atom(1:1).ne.'H' .and. &
3652                   atom.ne.'OP1' .and. atom.ne.'OP2 '.and. atom.ne.'OP3'&
3653                   ) then
3654 !            write (iout,*) "sidechain ",atom
3655 !            write (iout,*) "sidechain ",atom,molecule,ires,atom(3:3)
3656                  if ((molecule.ne.2).or.(atom(3:3).ne."'")) then
3657 !                        write (iout,*) "sidechain ",atom,molecule,ires,atom(3:3)
3658             iii=iii+1
3659             read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
3660               endif
3661           endif
3662 !         print *,"IONS",ions,card(1:6)
3663         else if ((ions).and.(card(1:6).eq.'HETATM')) then
3664        if (firstion.eq.0) then
3665        firstion=1
3666        if (unres_pdb) then
3667          do j=1,3
3668            dc(j,ires)=sccor(j,iii)
3669          enddo
3670        else
3671           call sccenter(ires,iii,sccor)
3672        endif ! unres_pdb
3673        endif !firstion
3674           read (card(12:16),*) atom
3675 !          print *,"HETATOM", atom
3676           read (card(18:20),'(a3)') res
3677           if ((atom(1:2).eq.'NA').or.(atom(1:2).eq.'CL').or.&
3678           (atom(1:2).eq.'CA').or.(atom(1:2).eq.'MG')           &
3679           .or.(atom(1:2).eq.'K ')) &
3680           then
3681            ires=ires+1
3682            if (molecule.ne.5) molecprev=molecule
3683            molecule=5
3684            nres_molec(molecule)=nres_molec(molecule)+1
3685            print *,"HERE",nres_molec(molecule)
3686            res=res(2:3)//' '
3687            itype(ires,molecule)=rescode(ires,res,0,molecule)
3688            read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
3689           endif! NA
3690         endif !atom
3691       enddo
3692    10 write (iout,'(a,i5)') ' Number of residues found: ',ires
3693       if (ires.eq.0) return
3694 ! Calculate dummy residue coordinates inside the "chain" of a multichain
3695 ! system
3696       nres=ires
3697       if (((ires_old.ne.ires).and.(molecule.ne.5)) &
3698         ) &
3699          nres_molec(molecule)=nres_molec(molecule)-2
3700       print *,'I have',nres, nres_molec(:)
3701
3702       do k=1,4 ! ions are without dummy
3703        if (nres_molec(k).eq.0) cycle
3704       do i=2,nres-1
3705 !        write (iout,*) i,itype(i,1)
3706 !        if (itype(i,1).eq.ntyp1) then
3707 !          write (iout,*) "dummy",i,itype(i,1)
3708 !          do j=1,3
3709 !            c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2
3710 !            c(j,i)=(c(j,i-1)+c(j,i+1))/2
3711 !            dc(j,i)=c(j,i)
3712 !          enddo
3713 !        endif
3714         if (itype(i,k).eq.ntyp1_molec(k)) then
3715          if (itype(i+1,k).eq.ntyp1_molec(k)) then
3716           if (itype(i+2,k).eq.0) then
3717 !           print *,"masz sieczke"
3718            do j=1,5
3719             if (itype(i+2,j).ne.0) then
3720             itype(i+1,k)=0
3721             itype(i+1,j)=ntyp1_molec(j)
3722             nres_molec(k)=nres_molec(k)-1
3723             nres_molec(j)=nres_molec(j)+1
3724             go to 3331
3725             endif
3726            enddo
3727  3331      continue
3728           endif
3729 ! 16/01/2014 by Adasko: Adding to dummy atoms in the chain
3730 ! first is connected prevous chain (itype(i+1,1).eq.ntyp1)=true
3731 ! second dummy atom is conected to next chain itype(i+1,1).eq.ntyp1=false
3732 !           if (unres_pdb) then
3733 ! 2/15/2013 by Adam: corrected insertion of the last dummy residue
3734 !            print *,i,'tu dochodze'
3735 !            call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
3736 !            if (fail) then
3737 !              e2(1)=0.0d0
3738 !              e2(2)=1.0d0
3739 !              e2(3)=0.0d0
3740 !            endif !fail
3741 !            print *,i,'a tu?'
3742 !            do j=1,3
3743 !             c(j,i)=c(j,i-1)-1.9d0*e2(j)
3744 !            enddo
3745 !           else   !unres_pdb
3746            do j=1,3
3747              dcj=(c(j,i-2)-c(j,i-3))/2.0
3748             if (dcj.eq.0) dcj=1.23591524223
3749              c(j,i)=c(j,i-1)+dcj
3750              c(j,nres+i)=c(j,i)
3751            enddo
3752 !          endif   !unres_pdb
3753          else     !itype(i+1,1).eq.ntyp1
3754 !          if (unres_pdb) then
3755 ! 2/15/2013 by Adam: corrected insertion of the first dummy residue
3756 !            call refsys(i+1,i+2,i+3,e1,e2,e3,fail)
3757 !            if (fail) then
3758 !              e2(1)=0.0d0
3759 !              e2(2)=1.0d0
3760 !              e2(3)=0.0d0
3761 !            endif
3762             do j=1,3
3763 !              c(j,i)=c(j,i+1)-1.9d0*e2(j)
3764              c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0)
3765             enddo
3766 !          else !unres_pdb
3767            do j=1,3
3768             dcj=(c(j,i+3)-c(j,i+2))/2.0
3769             if (dcj.eq.0) dcj=1.23591524223
3770             c(j,i)=c(j,i+1)-dcj
3771             c(j,nres+i)=c(j,i)
3772            enddo
3773 !          endif !unres_pdb
3774          endif !itype(i+1,1).eq.ntyp1
3775         endif  !itype.eq.ntyp1
3776
3777       enddo
3778       enddo
3779 ! Calculate the CM of the last side chain.
3780       if (iii.gt.0)  then
3781       if (unres_pdb) then
3782         do j=1,3
3783           dc(j,ires)=sccor(j,iii)
3784         enddo
3785       else
3786         call sccenter(ires,iii,sccor)
3787       endif
3788       endif
3789 !      nres=ires
3790       nsup=nres
3791       nstart_sup=1
3792 !      print *,"molecule",molecule
3793       if ((itype(nres,1).ne.10)) then
3794         nres=nres+1
3795           if (molecule.eq.5) molecule=molecprev
3796         itype(nres,molecule)=ntyp1_molec(molecule)
3797         nres_molec(molecule)=nres_molec(molecule)+1
3798 !        if (unres_pdb) then
3799 ! 2/15/2013 by Adam: corrected insertion of the last dummy residue
3800 !          call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
3801 !          if (fail) then
3802 !            e2(1)=0.0d0
3803 !            e2(2)=1.0d0
3804 !            e2(3)=0.0d0
3805 !          endif
3806 !          do j=1,3
3807 !            c(j,nres)=c(j,nres-1)-1.9d0*e2(j)
3808 !          enddo
3809 !        else
3810         do j=1,3
3811           dcj=(c(j,nres-2)-c(j,nres-3))/2.0
3812           c(j,nres)=c(j,nres-1)+dcj
3813           c(j,2*nres)=c(j,nres)
3814         enddo
3815 !        endif
3816       endif
3817 !     print *,'I have',nres, nres_molec(:)
3818
3819 !el kontrola nres w pliku inputowym WHAM-a w porownaniu z wartoscia wczytana z pliku pdb
3820 #ifdef WHAM_RUN
3821       if (nres.ne.nres0) then
3822         write (iout,*) "Error: wrong parameter value: NRES=",nres,&
3823                        " NRES0=",nres0
3824         stop "Error nres value in WHAM input"
3825       endif
3826 #endif
3827 !---------------------------------
3828 !el reallocate tables
3829 !      do i=1,maxres/3
3830 !       do j=1,2
3831 !         hfrag_alloc(j,i)=hfrag(j,i)
3832 !        enddo
3833 !       do j=1,4
3834 !         bfrag_alloc(j,i)=bfrag(j,i)
3835 !        enddo
3836 !      enddo
3837
3838 !      deallocate(hfrag)
3839 !      deallocate(bfrag)
3840 !      allocate(hfrag(2,nres/3)) !(2,maxres/3)
3841 !el      allocate(hfrag(2,nhfrag)) !(2,maxres/3)
3842 !el      allocate(bfrag(4,nbfrag)) !(4,maxres/3)
3843 !      allocate(bfrag(4,nres/3)) !(4,maxres/3)
3844
3845 !      do i=1,nhfrag
3846 !       do j=1,2
3847 !         hfrag(j,i)=hfrag_alloc(j,i)
3848 !        enddo
3849 !      enddo
3850 !      do i=1,nbfrag
3851 !       do j=1,4
3852 !         bfrag(j,i)=bfrag_alloc(j,i)
3853 !        enddo
3854 !      enddo
3855 !el end reallocate tables
3856 !---------------------------------
3857       do i=2,nres-1
3858         do j=1,3
3859           c(j,i+nres)=dc(j,i)
3860         enddo
3861       enddo
3862       do j=1,3
3863         c(j,nres+1)=c(j,1)
3864         c(j,2*nres)=c(j,nres)
3865       enddo
3866
3867       if (itype(1,1).eq.ntyp1) then
3868         nsup=nsup-1
3869         nstart_sup=2
3870         if (unres_pdb) then
3871 ! 2/15/2013 by Adam: corrected insertion of the first dummy residue
3872           call refsys(2,3,4,e1,e2,e3,fail)
3873           if (fail) then
3874             e2(1)=0.0d0
3875             e2(2)=1.0d0
3876             e2(3)=0.0d0
3877           endif
3878           do j=1,3
3879 !            c(j,1)=c(j,2)-1.9d0*e2(j)
3880              c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/sqrt(2.0d0)
3881           enddo
3882         else
3883         do j=1,3
3884           dcj=(c(j,4)-c(j,3))/2.0
3885           c(j,1)=c(j,2)-dcj
3886           c(j,nres+1)=c(j,1)
3887         enddo
3888         endif
3889       endif
3890 ! First lets assign correct dummy to correct type of chain
3891 ! 1) First residue
3892       if (itype(1,1).eq.ntyp1) then
3893         if (itype(2,1).eq.0) then
3894          do j=2,5
3895            if (itype(2,j).ne.0) then
3896            itype(1,1)=0
3897            itype(1,j)=ntyp1_molec(j)
3898            nres_molec(1)=nres_molec(1)-1
3899            nres_molec(j)=nres_molec(j)+1
3900            go to 3231
3901            endif
3902          enddo
3903 3231    continue
3904         endif
3905        endif
3906        print *,'I have',nres, nres_molec(:)
3907
3908 ! Copy the coordinates to reference coordinates
3909 !      do i=1,2*nres
3910 !        do j=1,3
3911 !          cref(j,i)=c(j,i)
3912 !        enddo
3913 !      enddo
3914 ! Calculate internal coordinates.
3915       if (lprn) then
3916       write (iout,'(/a)') &
3917         "Cartesian coordinates of the reference structure"
3918       write (iout,'(a,16x,3(3x,a5),5x,3(3x,a5))') &
3919        "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
3920       do ires=1,nres
3921         write (iout,'(5(a3,1x),i5,3f8.3,5x,3f8.3)') &
3922           (restyp(itype(ires,j),j),j=1,5),ires,(c(j,ires),j=1,3),&
3923           (c(j,ires+nres),j=1,3)
3924       enddo
3925       endif
3926 ! znamy już nres wiec mozna alokowac tablice
3927 ! Calculate internal coordinates.
3928       if(me.eq.king.or..not.out1file)then
3929        write (iout,'(a)') &
3930          "Backbone and SC coordinates as read from the PDB"
3931        do ires=1,nres
3932         write (iout,'(i5,i3,2x,a,3f8.3,5x,3f8.3)') &
3933           ires,itype(ires,1),restyp(itype(ires,1),1),(c(j,ires),j=1,3),&
3934           (c(j,nres+ires),j=1,3)
3935        enddo
3936       endif
3937 ! NOW LETS ROCK! SORTING
3938       allocate(c_temporary(3,2*nres))
3939       allocate(itype_temporary(nres,5))
3940       if (.not.allocated(molnum)) allocate(molnum(nres+1))
3941       if (.not.allocated(istype)) write(iout,*) &
3942           "SOMETHING WRONG WITH ISTYTPE"
3943       allocate(istype_temp(nres))
3944        itype_temporary(:,:)=0
3945       seqalingbegin=1
3946       do k=1,5
3947         do i=1,nres
3948          if (itype(i,k).ne.0) then
3949           do j=1,3
3950           c_temporary(j,seqalingbegin)=c(j,i)
3951           c_temporary(j,seqalingbegin+nres)=c(j,i+nres)
3952
3953           enddo
3954           itype_temporary(seqalingbegin,k)=itype(i,k)
3955           print *,i,k,itype(i,k),itype_temporary(seqalingbegin,k),seqalingbegin
3956           istype_temp(seqalingbegin)=istype(i)
3957           molnum(seqalingbegin)=k
3958           seqalingbegin=seqalingbegin+1
3959          endif
3960         enddo
3961        enddo
3962        do i=1,2*nres
3963         do j=1,3
3964         c(j,i)=c_temporary(j,i)
3965         enddo
3966        enddo
3967        do k=1,5
3968         do i=1,nres
3969          itype(i,k)=itype_temporary(i,k)
3970          istype(i)=istype_temp(i)
3971         enddo
3972        enddo
3973 !      if (itype(1,1).eq.ntyp1) then
3974 !        nsup=nsup-1
3975 !        nstart_sup=2
3976 !        if (unres_pdb) then
3977 ! 2/15/2013 by Adam: corrected insertion of the first dummy residue
3978 !          call refsys(2,3,4,e1,e2,e3,fail)
3979 !          if (fail) then
3980 !            e2(1)=0.0d0
3981 !            e2(2)=1.0d0
3982 !            e2(3)=0.0d0
3983 !          endif
3984 !          do j=1,3
3985 !            c(j,1)=c(j,2)-1.9d0*e2(j)
3986 !          enddo
3987 !        else
3988 !        do j=1,3
3989 !          dcj=(c(j,4)-c(j,3))/2.0
3990 !          c(j,1)=c(j,2)-dcj
3991 !          c(j,nres+1)=c(j,1)
3992 !        enddo
3993 !        endif
3994 !      endif
3995
3996       if (lprn) then
3997       write (iout,'(/a)') &
3998         "Cartesian coordinates of the reference structure after sorting"
3999       write (iout,'(a,16x,3(3x,a5),5x,3(3x,a5))') &
4000        "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
4001       do ires=1,nres
4002         write (iout,'(5(a3,1x),i5,3f8.3,5x,3f8.3)') &
4003           (restyp(itype(ires,j),j),j=1,5),ires,(c(j,ires),j=1,3),&
4004           (c(j,ires+nres),j=1,3)
4005       enddo
4006       endif
4007
4008 !       print *,seqalingbegin,nres
4009       if(.not.allocated(vbld)) then
4010        allocate(vbld(2*nres))
4011        do i=1,2*nres
4012          vbld(i)=0.d0
4013        enddo
4014       endif
4015       if(.not.allocated(vbld_inv)) then
4016        allocate(vbld_inv(2*nres))
4017        do i=1,2*nres
4018          vbld_inv(i)=0.d0
4019        enddo
4020       endif
4021 !!!el
4022       if(.not.allocated(theta)) then
4023         allocate(theta(nres+2))
4024         theta(:)=0.0d0
4025       endif
4026
4027       if(.not.allocated(phi)) allocate(phi(nres+2))
4028       if(.not.allocated(alph)) allocate(alph(nres+2))
4029       if(.not.allocated(omeg)) allocate(omeg(nres+2))
4030       if(.not.allocated(thetaref)) allocate(thetaref(nres+2))
4031       if(.not.allocated(phiref)) allocate(phiref(nres+2))
4032       if(.not.allocated(costtab)) allocate(costtab(nres))
4033       if(.not.allocated(sinttab)) allocate(sinttab(nres))
4034       if(.not.allocated(cost2tab)) allocate(cost2tab(nres))
4035       if(.not.allocated(sint2tab)) allocate(sint2tab(nres))
4036       if(.not.allocated(xxref)) allocate(xxref(nres))
4037       if(.not.allocated(yyref)) allocate(yyref(nres))
4038       if(.not.allocated(zzref)) allocate(zzref(nres)) !(maxres)
4039       if(.not.allocated(dc_norm)) then
4040 !      if(.not.allocated(dc_norm)) allocate(dc_norm(3,0:2*nres+2))
4041         allocate(dc_norm(3,0:2*nres+2))
4042         dc_norm(:,:)=0.d0
4043       endif
4044
4045       call int_from_cart(.true.,.false.)
4046       call sc_loc_geom(.false.)
4047       do i=1,nres
4048         thetaref(i)=theta(i)
4049         phiref(i)=phi(i)
4050       enddo
4051 !      do i=1,2*nres
4052 !        vbld_inv(i)=0.d0
4053 !        vbld(i)=0.d0
4054 !      enddo
4055
4056       do i=1,nres-1
4057         do j=1,3
4058           dc(j,i)=c(j,i+1)-c(j,i)
4059           dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
4060         enddo
4061       enddo
4062       do i=2,nres-1
4063         do j=1,3
4064           dc(j,i+nres)=c(j,i+nres)-c(j,i)
4065           dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
4066         enddo
4067 !      write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),&
4068 !        vbld_inv(i+nres)
4069       enddo
4070 !      call chainbuild
4071 ! Copy the coordinates to reference coordinates
4072 ! Splits to single chain if occurs
4073
4074 !      do i=1,2*nres
4075 !        do j=1,3
4076 !          cref(j,i,cou)=c(j,i)
4077 !        enddo
4078 !      enddo
4079 !
4080       if(.not.allocated(cref)) allocate(cref(3,2*nres+2,maxperm)) !(3,maxres2+2,maxperm)
4081       if(.not.allocated(chain_rep)) allocate(chain_rep(3,2*nres+2,maxsym)) !(3,maxres2+2,maxsym)
4082       if(.not.allocated(tabperm)) allocate(tabperm(maxperm,maxsym)) !(maxperm,maxsym)
4083 !-----------------------------
4084       kkk=1
4085       lll=0
4086       cou=1
4087         write (iout,*) "symetr", symetr
4088       do i=1,nres
4089       lll=lll+1
4090 !      write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
4091       if (i.gt.1) then
4092       if ((itype(i-1,1).eq.ntyp1).and.(i.gt.2)) then
4093       chain_length=lll-1
4094       kkk=kkk+1
4095 !       write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
4096       lll=1
4097       endif
4098       endif
4099         do j=1,3
4100           cref(j,i,cou)=c(j,i)
4101           cref(j,i+nres,cou)=c(j,i+nres)
4102           if (i.le.nres) then
4103           chain_rep(j,lll,kkk)=c(j,i)
4104           chain_rep(j,lll+nres,kkk)=c(j,i+nres)
4105           endif
4106          enddo
4107       enddo
4108       write (iout,*) chain_length
4109       if (chain_length.eq.0) chain_length=nres
4110       do j=1,3
4111       chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
4112       chain_rep(j,chain_length+nres,symetr) &
4113       =chain_rep(j,chain_length+nres,1)
4114       enddo
4115 ! diagnostic
4116 !       write (iout,*) "spraw lancuchy",chain_length,symetr
4117 !       do i=1,4
4118 !         do kkk=1,chain_length
4119 !           write (iout,*) itype(kkk,1),(chain_rep(j,kkk,i), j=1,3)
4120 !         enddo
4121 !        enddo
4122 ! enddiagnostic
4123 ! makes copy of chains
4124         write (iout,*) "symetr", symetr
4125       do j=1,3
4126       dc(j,0)=c(j,1)
4127       enddo
4128
4129       if (symetr.gt.1) then
4130        call permut(symetr)
4131        nperm=1
4132        do i=1,symetr
4133        nperm=nperm*i
4134        enddo
4135        do i=1,nperm
4136        write(iout,*) (tabperm(i,kkk),kkk=1,4)
4137        enddo
4138        do i=1,nperm
4139         cou=0
4140         do kkk=1,symetr
4141          icha=tabperm(i,kkk)
4142          write (iout,*) i,icha
4143          do lll=1,chain_length
4144           cou=cou+1
4145            if (cou.le.nres) then
4146            do j=1,3
4147             kupa=mod(lll,chain_length)
4148             iprzes=(kkk-1)*chain_length+lll
4149             if (kupa.eq.0) kupa=chain_length
4150             write (iout,*) "kupa", kupa
4151             cref(j,iprzes,i)=chain_rep(j,kupa,icha)
4152             cref(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha)
4153           enddo
4154           endif
4155          enddo
4156         enddo
4157        enddo
4158        endif
4159 !-koniec robienia kopii
4160 ! diag
4161       do kkk=1,nperm
4162       write (iout,*) "nowa struktura", nperm
4163       do i=1,nres
4164         write (iout,110) restyp(itype(i,1),1),i,cref(1,i,kkk),&
4165       cref(2,i,kkk),&
4166       cref(3,i,kkk),cref(1,nres+i,kkk),&
4167       cref(2,nres+i,kkk),cref(3,nres+i,kkk)
4168       enddo
4169   100 format (//'                alpha-carbon coordinates       ',&
4170                 '     centroid coordinates'/ &
4171                 '       ', 6X,'X',11X,'Y',11X,'Z', &
4172                                 10X,'X',11X,'Y',11X,'Z')
4173   110 format (a,'(',i5,')',6f12.5)
4174
4175       enddo
4176 !c enddiag
4177       do j=1,nbfrag
4178         do i=1,4
4179          bfrag(i,j)=bfrag(i,j)-ishift
4180         enddo
4181       enddo
4182
4183       do j=1,nhfrag
4184         do i=1,2
4185          hfrag(i,j)=hfrag(i,j)-ishift
4186         enddo
4187       enddo
4188       ishift_pdb=ishift
4189
4190       return
4191       end subroutine readpdb
4192 #if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
4193 !-----------------------------------------------------------------------------
4194 ! readrtns_CSA.F
4195 !-----------------------------------------------------------------------------
4196       subroutine read_control
4197 !
4198 ! Read contorl data
4199 !
4200 !      use geometry_data
4201       use comm_machsw
4202       use energy_data
4203       use control_data
4204       use compare_data
4205       use MCM_data
4206       use map_data
4207       use csa_data
4208       use MD_data
4209       use MPI_data
4210       use random, only: random_init
4211 !      implicit real*8 (a-h,o-z)
4212 !      include 'DIMENSIONS'
4213 #ifdef MP
4214       use prng, only:prng_restart
4215       include 'mpif.h'
4216       logical :: OKRandom!, prng_restart
4217       real(kind=8) :: r1
4218 #endif
4219 !      include 'COMMON.IOUNITS'
4220 !      include 'COMMON.TIME1'
4221 !      include 'COMMON.THREAD'
4222 !      include 'COMMON.SBRIDGE'
4223 !      include 'COMMON.CONTROL'
4224 !      include 'COMMON.MCM'
4225 !      include 'COMMON.MAP'
4226 !      include 'COMMON.HEADER'
4227 !      include 'COMMON.CSA'
4228 !      include 'COMMON.CHAIN'
4229 !      include 'COMMON.MUCA'
4230 !      include 'COMMON.MD'
4231 !      include 'COMMON.FFIELD'
4232 !      include 'COMMON.INTERACT'
4233 !      include 'COMMON.SETUP'
4234 !el      integer :: KDIAG,ICORFL,IXDR
4235 !el      COMMON /MACHSW/ KDIAG,ICORFL,IXDR
4236       character(len=8),dimension(0:3) :: diagmeth = reshape((/'Library ',&
4237         'EVVRSP  ','Givens  ','Jacobi  '/),shape(diagmeth))
4238 !      character(len=80) :: ucase
4239       character(len=640) :: controlcard
4240
4241       real(kind=8) :: seed,rmsdbc,rmsdbc1max,rmsdbcm,drms,timem!,&
4242       integer i
4243
4244       nglob_csa=0
4245       eglob_csa=1d99
4246       nmin_csa=0
4247       read (INP,'(a)') titel
4248       call card_concat(controlcard,.true.)
4249 !      out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0
4250 !      print *,"Processor",me," fg_rank",fg_rank," out1file",out1file
4251       call reada(controlcard,'SEED',seed,0.0D0)
4252       call random_init(seed)
4253 ! Set up the time limit (caution! The time must be input in minutes!)
4254       read_cart=index(controlcard,'READ_CART').gt.0
4255       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
4256       call readi(controlcard,'SYM',symetr,1)
4257       call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours
4258       unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
4259       call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes
4260       call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
4261       call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
4262       call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
4263       call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
4264       call reada(controlcard,'DRMS',drms,0.1D0)
4265       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4266        write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
4267        write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
4268        write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
4269        write (iout,'(a,f10.1)')'DRMS    = ',drms
4270        write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
4271        write (iout,'(a,f10.1)') 'Time limit (min):',timlim
4272       endif
4273       call readi(controlcard,'NZ_START',nz_start,0)
4274       call readi(controlcard,'NZ_END',nz_end,0)
4275       call readi(controlcard,'IZ_SC',iz_sc,0)
4276       timlim=60.0D0*timlim
4277       safety = 60.0d0*safety
4278       timem=timlim
4279       modecalc=0
4280       call reada(controlcard,"T_BATH",t_bath,300.0d0)
4281 !C SHIELD keyword sets if the shielding effect of side-chains is used
4282 !C 0 denots no shielding is used all peptide are equally despite the
4283 !C solvent accesible area
4284 !C 1 the newly introduced function
4285 !C 2 reseved for further possible developement
4286       call readi(controlcard,'SHIELD',shield_mode,0)
4287 !C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4288         write(iout,*) "shield_mode",shield_mode
4289       call readi(controlcard,'TORMODE',tor_mode,0)
4290 !C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4291         write(iout,*) "torsional and valence angle mode",tor_mode
4292
4293 !C  Varibles set size of box
4294       with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
4295       protein=index(controlcard,"PROTEIN").gt.0
4296       ions=index(controlcard,"IONS").gt.0
4297       nucleic=index(controlcard,"NUCLEIC").gt.0
4298       write (iout,*) "with_theta_constr ",with_theta_constr
4299       AFMlog=(index(controlcard,'AFM'))
4300       selfguide=(index(controlcard,'SELFGUIDE'))
4301       print *,'AFMlog',AFMlog,selfguide,"KUPA"
4302       call readi(controlcard,'GENCONSTR',genconstr,0)
4303       call reada(controlcard,'BOXX',boxxsize,100.0d0)
4304       call reada(controlcard,'BOXY',boxysize,100.0d0)
4305       call reada(controlcard,'BOXZ',boxzsize,100.0d0)
4306       call readi(controlcard,'TUBEMOD',tubemode,0)
4307       print *,"SCELE",scelemode
4308       call readi(controlcard,"SCELEMODE",scelemode,0)
4309       print *,"SCELE",scelemode
4310
4311 ! elemode = 0 is orignal UNRES electrostatics
4312 ! elemode = 1 is "Momo" potentials in progress
4313 ! elemode = 2 is in development EVALD
4314
4315
4316       write (iout,*) TUBEmode,"TUBEMODE"
4317       if (TUBEmode.gt.0) then
4318        call reada(controlcard,"XTUBE",tubecenter(1),0.0d0)
4319        call reada(controlcard,"YTUBE",tubecenter(2),0.0d0)
4320        call reada(controlcard,"ZTUBE",tubecenter(3),0.0d0)
4321        call reada(controlcard,"RTUBE",tubeR0,0.0d0)
4322        call reada(controlcard,"TUBETOP",bordtubetop,boxzsize)
4323        call reada(controlcard,"TUBEBOT",bordtubebot,0.0d0)
4324        call reada(controlcard,"TUBEBUF",tubebufthick,1.0d0)
4325        buftubebot=bordtubebot+tubebufthick
4326        buftubetop=bordtubetop-tubebufthick
4327       endif
4328
4329 ! CUTOFFF ON ELECTROSTATICS
4330       call reada(controlcard,"R_CUT_ELE",r_cut_ele,15.0d0)
4331       call reada(controlcard,"LAMBDA_ELE",rlamb_ele,0.3d0)
4332       write(iout,*) "R_CUT_ELE=",r_cut_ele
4333 ! Lipidic parameters
4334       call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
4335       call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
4336       if (lipthick.gt.0.0d0) then
4337        bordliptop=(boxzsize+lipthick)/2.0
4338        bordlipbot=bordliptop-lipthick
4339       if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0)) &
4340       write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
4341       buflipbot=bordlipbot+lipbufthick
4342       bufliptop=bordliptop-lipbufthick
4343       if ((lipbufthick*2.0d0).gt.lipthick) &
4344        write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
4345       endif !lipthick.gt.0
4346       write(iout,*) "bordliptop=",bordliptop
4347       write(iout,*) "bordlipbot=",bordlipbot
4348       write(iout,*) "bufliptop=",bufliptop
4349       write(iout,*) "buflipbot=",buflipbot
4350       write (iout,*) "SHIELD MODE",shield_mode
4351
4352 !C-------------------------
4353       minim=(index(controlcard,'MINIMIZE').gt.0)
4354       dccart=(index(controlcard,'CART').gt.0)
4355       overlapsc=(index(controlcard,'OVERLAP').gt.0)
4356       overlapsc=.not.overlapsc
4357       searchsc=(index(controlcard,'NOSEARCHSC').gt.0)
4358       searchsc=.not.searchsc
4359       sideadd=(index(controlcard,'SIDEADD').gt.0)
4360       energy_dec=(index(controlcard,'ENERGY_DEC').gt.0)
4361       outpdb=(index(controlcard,'PDBOUT').gt.0)
4362       outmol2=(index(controlcard,'MOL2OUT').gt.0)
4363       pdbref=(index(controlcard,'PDBREF').gt.0)
4364       refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
4365       indpdb=index(controlcard,'PDBSTART')
4366       extconf=(index(controlcard,'EXTCONF').gt.0)
4367       call readi(controlcard,'IPRINT',iprint,0)
4368       call readi(controlcard,'MAXGEN',maxgen,10000)
4369       call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
4370       call readi(controlcard,"KDIAG",kdiag,0)
4371       call readi(controlcard,"RESCALE_MODE",rescale_mode,2)
4372       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) &
4373        write (iout,*) "RESCALE_MODE",rescale_mode
4374       split_ene=index(controlcard,'SPLIT_ENE').gt.0
4375       if (index(controlcard,'REGULAR').gt.0.0D0) then
4376         call reada(controlcard,'WEIDIS',weidis,0.1D0)
4377         modecalc=1
4378         refstr=.true.
4379       endif
4380       if (index(controlcard,'CHECKGRAD').gt.0) then
4381         modecalc=5
4382         if (index(controlcard,'CART').gt.0) then
4383           icheckgrad=1
4384         elseif (index(controlcard,'CARINT').gt.0) then
4385           icheckgrad=2
4386         else
4387           icheckgrad=3
4388         endif
4389       elseif (index(controlcard,'THREAD').gt.0) then
4390         modecalc=2
4391         call readi(controlcard,'THREAD',nthread,0)
4392         if (nthread.gt.0) then
4393           call reada(controlcard,'WEIDIS',weidis,0.1D0)
4394         else
4395           if (fg_rank.eq.0) &
4396           write (iout,'(a)')'A number has to follow the THREAD keyword.'
4397           stop 'Error termination in Read_Control.'
4398         endif
4399       else if (index(controlcard,'MCMA').gt.0) then
4400         modecalc=3
4401       else if (index(controlcard,'MCEE').gt.0) then
4402         modecalc=6
4403       else if (index(controlcard,'MULTCONF').gt.0) then
4404         modecalc=4
4405       else if (index(controlcard,'MAP').gt.0) then
4406         modecalc=7
4407         call readi(controlcard,'MAP',nmap,0)
4408       else if (index(controlcard,'CSA').gt.0) then
4409         modecalc=8
4410 !rc      else if (index(controlcard,'ZSCORE').gt.0) then
4411 !rc
4412 !rc  ZSCORE is rm from UNRES, modecalc=9 is available
4413 !rc
4414 !rc        modecalc=9
4415 !fcm      else if (index(controlcard,'MCMF').gt.0) then
4416 !fmc        modecalc=10
4417       else if (index(controlcard,'SOFTREG').gt.0) then
4418         modecalc=11
4419       else if (index(controlcard,'CHECK_BOND').gt.0) then
4420         modecalc=-1
4421       else if (index(controlcard,'TEST').gt.0) then
4422         modecalc=-2
4423       else if (index(controlcard,'MD').gt.0) then
4424         modecalc=12
4425       else if (index(controlcard,'RE ').gt.0) then
4426         modecalc=14
4427       endif
4428
4429       lmuca=index(controlcard,'MUCA').gt.0
4430       call readi(controlcard,'MUCADYN',mucadyn,0)
4431       call readi(controlcard,'MUCASMOOTH',muca_smooth,0)
4432       if (lmuca .and. (me.eq.king .or. .not.out1file )) &
4433        then
4434        write (iout,*) 'MUCADYN=',mucadyn
4435        write (iout,*) 'MUCASMOOTH=',muca_smooth
4436       endif
4437
4438       iscode=index(controlcard,'ONE_LETTER')
4439       indphi=index(controlcard,'PHI')
4440       indback=index(controlcard,'BACK')
4441       iranconf=index(controlcard,'RAND_CONF')
4442       i2ndstr=index(controlcard,'USE_SEC_PRED')
4443       gradout=index(controlcard,'GRADOUT').gt.0
4444       gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
4445       call reada(controlcard,'DISTCHAINMAX',distchainmax,5.0d0)
4446       if (me.eq.king .or. .not.out1file ) &
4447         write (iout,*) "DISTCHAINMAX",distchainmax
4448
4449       if(me.eq.king.or..not.out1file) &
4450        write (iout,'(2a)') diagmeth(kdiag),&
4451         ' routine used to diagonalize matrices.'
4452       if (shield_mode.gt.0) then
4453        pi=4.0D0*datan(1.0D0)
4454 !C VSolvSphere the volume of solving sphere
4455       print *,pi,"pi"
4456 !C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
4457 !C there will be no distinction between proline peptide group and normal peptide
4458 !C group in case of shielding parameters
4459       VSolvSphere=4.0/3.0*pi*(4.50d0)**3
4460       VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(4.50/2.0)**3
4461       write (iout,*) VSolvSphere,VSolvSphere_div
4462 !C long axis of side chain
4463 !      do i=1,ntyp
4464 !      long_r_sidechain(i)=vbldsc0(1,i)
4465 !      short_r_sidechain(i)=sigma0(i)
4466 !      write(iout,*) "parame for long and short axis",i,vbldsc0(1,i),&
4467 !         sigma0(i)
4468 !      enddo
4469       buff_shield=1.0d0
4470       endif
4471       return
4472       end subroutine read_control
4473 !-----------------------------------------------------------------------------
4474       subroutine read_REMDpar
4475 !
4476 ! Read REMD settings
4477 !
4478 !       use control
4479 !       use energy
4480 !       use geometry
4481       use REMD_data
4482       use MPI_data
4483       use control_data, only:out1file
4484 !      implicit real*8 (a-h,o-z)
4485 !      include 'DIMENSIONS'
4486 !      include 'COMMON.IOUNITS'
4487 !      include 'COMMON.TIME1'
4488 !      include 'COMMON.MD'
4489       use MD_data
4490 !el #ifndef LANG0
4491 !el      include 'COMMON.LANGEVIN'
4492 !el #else
4493 !el      include 'COMMON.LANGEVIN.lang0'
4494 !el #endif
4495 !      include 'COMMON.INTERACT'
4496 !      include 'COMMON.NAMES'
4497 !      include 'COMMON.GEO'
4498 !      include 'COMMON.REMD'
4499 !      include 'COMMON.CONTROL'
4500 !      include 'COMMON.SETUP'
4501 !      character(len=80) :: ucase
4502       character(len=320) :: controlcard
4503       character(len=3200) :: controlcard1
4504       integer :: iremd_m_total
4505 !el local variables
4506       integer :: i
4507 !     real(kind=8) :: var,ene
4508
4509       if(me.eq.king.or..not.out1file) &
4510        write (iout,*) "REMD setup"
4511
4512       call card_concat(controlcard,.true.)
4513       call readi(controlcard,"NREP",nrep,3)
4514       call readi(controlcard,"NSTEX",nstex,1000)
4515       call reada(controlcard,"RETMIN",retmin,10.0d0)
4516       call reada(controlcard,"RETMAX",retmax,1000.0d0)
4517       mremdsync=(index(controlcard,'SYNC').gt.0)
4518       call readi(controlcard,"NSYN",i_sync_step,100)
4519       restart1file=(index(controlcard,'REST1FILE').gt.0)
4520       traj1file=(index(controlcard,'TRAJ1FILE').gt.0)
4521       call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1)
4522       if(max_cache_traj_use.gt.max_cache_traj) &
4523                 max_cache_traj_use=max_cache_traj
4524       if(me.eq.king.or..not.out1file) then
4525 !d       if (traj1file) then
4526 !rc caching is in testing - NTWX is not ignored
4527 !d        write (iout,*) "NTWX value is ignored"
4528 !d        write (iout,*) "  trajectory is stored to one file by master"
4529 !d        write (iout,*) "  before exchange at NSTEX intervals"
4530 !d       endif
4531        write (iout,*) "NREP= ",nrep
4532        write (iout,*) "NSTEX= ",nstex
4533        write (iout,*) "SYNC= ",mremdsync
4534        write (iout,*) "NSYN= ",i_sync_step
4535        write (iout,*) "TRAJCACHE= ",max_cache_traj_use
4536       endif
4537       remd_tlist=.false.
4538       allocate(remd_t(nrep),remd_m(nrep)) !(maxprocs)
4539       if (index(controlcard,'TLIST').gt.0) then
4540          remd_tlist=.true.
4541          call card_concat(controlcard1,.true.)
4542          read(controlcard1,*) (remd_t(i),i=1,nrep)
4543          if(me.eq.king.or..not.out1file) &
4544           write (iout,*)'tlist',(remd_t(i),i=1,nrep)
4545       endif
4546       remd_mlist=.false.
4547       if (index(controlcard,'MLIST').gt.0) then
4548          remd_mlist=.true.
4549          call card_concat(controlcard1,.true.)
4550          read(controlcard1,*) (remd_m(i),i=1,nrep)
4551          if(me.eq.king.or..not.out1file) then
4552           write (iout,*)'mlist',(remd_m(i),i=1,nrep)
4553           iremd_m_total=0
4554           do i=1,nrep
4555            iremd_m_total=iremd_m_total+remd_m(i)
4556           enddo
4557           write (iout,*) 'Total number of replicas ',iremd_m_total
4558          endif
4559       endif
4560       if(me.eq.king.or..not.out1file) &
4561        write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
4562       return
4563       end subroutine read_REMDpar
4564 !-----------------------------------------------------------------------------
4565       subroutine read_MDpar
4566 !
4567 ! Read MD settings
4568 !
4569       use control_data, only: r_cut,rlamb,out1file
4570       use energy_data
4571       use geometry_data, only: pi
4572       use MPI_data
4573 !      implicit real*8 (a-h,o-z)
4574 !      include 'DIMENSIONS'
4575 !      include 'COMMON.IOUNITS'
4576 !      include 'COMMON.TIME1'
4577 !      include 'COMMON.MD'
4578       use MD_data
4579 !el #ifndef LANG0
4580 !el      include 'COMMON.LANGEVIN'
4581 !el #else
4582 !el      include 'COMMON.LANGEVIN.lang0'
4583 !el #endif
4584 !      include 'COMMON.INTERACT'
4585 !      include 'COMMON.NAMES'
4586 !      include 'COMMON.GEO'
4587 !      include 'COMMON.SETUP'
4588 !      include 'COMMON.CONTROL'
4589 !      include 'COMMON.SPLITELE'
4590 !      character(len=80) :: ucase
4591       character(len=320) :: controlcard
4592 !el local variables
4593       integer :: i,j
4594       real(kind=8) :: eta
4595
4596       call card_concat(controlcard,.true.)
4597       call readi(controlcard,"NSTEP",n_timestep,1000000)
4598       call readi(controlcard,"NTWE",ntwe,100)
4599       call readi(controlcard,"NTWX",ntwx,1000)
4600       call reada(controlcard,"DT",d_time,1.0d-1)
4601       call reada(controlcard,"DVMAX",dvmax,2.0d1)
4602       call reada(controlcard,"DAMAX",damax,1.0d1)
4603       call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1)
4604       call readi(controlcard,"LANG",lang,0)
4605       RESPA = index(controlcard,"RESPA") .gt. 0
4606       call readi(controlcard,"NTIME_SPLIT",ntime_split,1)
4607       ntime_split0=ntime_split
4608       call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64)
4609       ntime_split0=ntime_split
4610       call reada(controlcard,"R_CUT",r_cut,2.0d0)
4611       call reada(controlcard,"LAMBDA",rlamb,0.3d0)
4612       rest = index(controlcard,"REST").gt.0
4613       tbf = index(controlcard,"TBF").gt.0
4614       usampl = index(controlcard,"USAMPL").gt.0
4615       mdpdb = index(controlcard,"MDPDB").gt.0
4616       call reada(controlcard,"T_BATH",t_bath,300.0d0)
4617       call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1)
4618       call reada(controlcard,"EQ_TIME",eq_time,1.0d+4)
4619       call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000)
4620       if (count_reset_moment.eq.0) count_reset_moment=1000000000
4621       call readi(controlcard,"RESET_VEL",count_reset_vel,1000)
4622       reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0
4623       reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0
4624       if (count_reset_vel.eq.0) count_reset_vel=1000000000
4625       large = index(controlcard,"LARGE").gt.0
4626       print_compon = index(controlcard,"PRINT_COMPON").gt.0
4627       rattle = index(controlcard,"RATTLE").gt.0
4628       preminim=(index(controlcard,'PREMINIM').gt.0)
4629       write (iout,*) "PREMINIM ",preminim
4630       dccart=(index(controlcard,'CART').gt.0)
4631       if (preminim) call read_minim
4632 !  if performing umbrella sampling, fragments constrained are read from the fragment file
4633       nset=0
4634       if(usampl) then
4635         call read_fragments
4636       endif
4637
4638       if(me.eq.king.or..not.out1file) then
4639        write (iout,*)
4640        write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run "
4641        write (iout,*)
4642        write (iout,'(a)') "The units are:"
4643        write (iout,'(a)') "positions: angstrom, time: 48.9 fs"
4644        write (iout,'(2a)') "velocity: angstrom/(48.9 fs),",&
4645         " acceleration: angstrom/(48.9 fs)**2"
4646        write (iout,'(a)') "energy: kcal/mol, temperature: K"
4647        write (iout,*)
4648        write (iout,'(a60,i10)') "Number of time steps:",n_timestep
4649        write (iout,'(a60,f10.5,a)') &
4650         "Initial time step of numerical integration:",d_time,&
4651         " natural units"
4652        write (iout,'(60x,f10.5,a)') d_time*48.9," fs"
4653        if (RESPA) then
4654         write (iout,'(2a,i4,a)') &
4655           "A-MTS algorithm used; initial time step for fast-varying",&
4656           " short-range forces split into",ntime_split," steps."
4657         write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff",&
4658          r_cut," lambda",rlamb
4659        endif
4660        write (iout,'(2a,f10.5)') &
4661         "Maximum acceleration threshold to reduce the time step",&
4662         "/increase split number:",damax
4663        write (iout,'(2a,f10.5)') &
4664         "Maximum predicted energy drift to reduce the timestep",&
4665         "/increase split number:",edriftmax
4666        write (iout,'(a60,f10.5)') &
4667        "Maximum velocity threshold to reduce velocities:",dvmax
4668        write (iout,'(a60,i10)') "Frequency of property output:",ntwe
4669        write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx
4670        if (rattle) write (iout,'(a60)') &
4671         "Rattle algorithm used to constrain the virtual bonds"
4672       endif
4673       reset_fricmat=1000
4674       if (lang.gt.0) then
4675         call reada(controlcard,"ETAWAT",etawat,0.8904d0)
4676         call reada(controlcard,"RWAT",rwat,1.4d0)
4677         call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2)
4678         surfarea=index(controlcard,"SURFAREA").gt.0
4679         call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000)
4680         if(me.eq.king.or..not.out1file)then
4681          write (iout,'(/a,$)') "Langevin dynamics calculation"
4682          if (lang.eq.1) then
4683           write (iout,'(a/)') &
4684             " with direct integration of Langevin equations"
4685          else if (lang.eq.2) then
4686           write (iout,'(a/)') " with TINKER stochasic MD integrator"
4687          else if (lang.eq.3) then
4688           write (iout,'(a/)') " with Ciccotti's stochasic MD integrator"
4689          else if (lang.eq.4) then
4690           write (iout,'(a/)') " in overdamped mode"
4691          else
4692           write (iout,'(//a,i5)') &
4693             "=========== ERROR: Unknown Langevin dynamics mode:",lang
4694           stop
4695          endif
4696          write (iout,'(a60,f10.5)') "Temperature:",t_bath
4697          write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat
4698          write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat
4699          write (iout,'(a60,f10.5)') &
4700          "Scaling factor of the friction forces:",scal_fric
4701          if (surfarea) write (iout,'(2a,i10,a)') &
4702            "Friction coefficients will be scaled by solvent-accessible",&
4703            " surface area every",reset_fricmat," steps."
4704         endif
4705 ! Calculate friction coefficients and bounds of stochastic forces
4706         eta=6*pi*cPoise*etawat
4707         if(me.eq.king.or..not.out1file) &
4708          write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:",&
4709           eta
4710 !        allocate(gamp
4711         do j=1,5 !types of molecules
4712         gamp(j)=scal_fric*(pstok(j)+rwat)*eta
4713         stdfp(j)=dsqrt(2*Rb*t_bath/d_time)
4714         enddo
4715         allocate(gamsc(ntyp1,5),stdfsc(ntyp1,5)) !(ntyp1)
4716         do j=1,5 !types of molecules
4717         do i=1,ntyp
4718           gamsc(i,j)=scal_fric*(restok(i,j)+rwat)*eta
4719           stdfsc(i,j)=dsqrt(2*Rb*t_bath/d_time)
4720         enddo
4721         enddo
4722
4723         if(me.eq.king.or..not.out1file)then
4724          write (iout,'(/2a/)') &
4725          "Radii of site types and friction coefficients and std's of",&
4726          " stochastic forces of fully exposed sites"
4727          write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp(1),stdfp*dsqrt(gamp(1))
4728          do i=1,ntyp
4729           write (iout,'(a5,f5.2,2f10.5)') restyp(i,1),restok(i,1),&
4730            gamsc(i,1),stdfsc(i,1)*dsqrt(gamsc(i,1))
4731          enddo
4732         endif
4733       else if (tbf) then
4734         if(me.eq.king.or..not.out1file)then
4735          write (iout,'(a)') "Berendsen bath calculation"
4736          write (iout,'(a60,f10.5)') "Temperature:",t_bath
4737          write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath
4738          if (reset_moment) &
4739          write (iout,'(a,i10,a)') "Momenta will be reset at zero every",&
4740          count_reset_moment," steps"
4741          if (reset_vel) &
4742           write (iout,'(a,i10,a)') &
4743           "Velocities will be reset at random every",count_reset_vel,&
4744          " steps"
4745         endif
4746       else
4747         if(me.eq.king.or..not.out1file) &
4748          write (iout,'(a31)') "Microcanonical mode calculation"
4749       endif
4750       if(me.eq.king.or..not.out1file)then
4751        if (rest) write (iout,'(/a/)') "===== Calculation restarted ===="
4752        if (usampl) then
4753           write(iout,*) "MD running with constraints."
4754           write(iout,*) "Equilibration time ", eq_time, " mtus."
4755           write(iout,*) "Constraining ", nfrag," fragments."
4756           write(iout,*) "Length of each fragment, weight and q0:"
4757           do iset=1,nset
4758            write (iout,*) "Set of restraints #",iset
4759            do i=1,nfrag
4760               write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset),&
4761                  ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset)
4762            enddo
4763            write(iout,*) "constraints between ", npair, "fragments."
4764            write(iout,*) "constraint pairs, weights and q0:"
4765            do i=1,npair
4766             write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset),&
4767                    ipair(2,i,iset),wpair(i,iset),qinpair(i,iset)
4768            enddo
4769            write(iout,*) "angle constraints within ", nfrag_back,&
4770             "backbone fragments."
4771            write(iout,*) "fragment, weights:"
4772            do i=1,nfrag_back
4773             write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset),&
4774                ifrag_back(2,i,iset),wfrag_back(1,i,iset),&
4775                wfrag_back(2,i,iset),wfrag_back(3,i,iset)
4776            enddo
4777           enddo
4778         iset=mod(kolor,nset)+1
4779        endif
4780       endif
4781       if(me.eq.king.or..not.out1file) &
4782        write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup "
4783       return
4784       end subroutine read_MDpar
4785 !-----------------------------------------------------------------------------
4786       subroutine map_read
4787
4788       use map_data
4789 !      implicit real*8 (a-h,o-z)
4790 !      include 'DIMENSIONS'
4791 !      include 'COMMON.MAP'
4792 !      include 'COMMON.IOUNITS'
4793       character(len=3) :: angid(4) = (/'THE','PHI','ALP','OME'/)
4794       character(len=80) :: mapcard      !,ucase
4795 !el local variables
4796       integer :: imap
4797 !     real(kind=8) :: var,ene
4798
4799       do imap=1,nmap
4800         read (inp,'(a)') mapcard
4801         mapcard=ucase(mapcard)
4802         if (index(mapcard,'PHI').gt.0) then
4803           kang(imap)=1
4804         else if (index(mapcard,'THE').gt.0) then
4805           kang(imap)=2
4806         else if (index(mapcard,'ALP').gt.0) then
4807           kang(imap)=3
4808         else if (index(mapcard,'OME').gt.0) then
4809           kang(imap)=4
4810         else
4811           write(iout,'(a)')'Error - illegal variable spec in MAP card.'
4812           stop 'Error - illegal variable spec in MAP card.'
4813         endif
4814         call readi (mapcard,'RES1',res1(imap),0)
4815         call readi (mapcard,'RES2',res2(imap),0)
4816         if (res1(imap).eq.0) then
4817           res1(imap)=res2(imap)
4818         else if (res2(imap).eq.0) then
4819           res2(imap)=res1(imap)
4820         endif
4821         if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then
4822           write (iout,'(a)') &
4823           'Error - illegal definition of variable group in MAP.'
4824           stop 'Error - illegal definition of variable group in MAP.'
4825         endif
4826         call reada(mapcard,'FROM',ang_from(imap),0.0D0)
4827         call reada(mapcard,'TO',ang_to(imap),0.0D0)
4828         call readi(mapcard,'NSTEP',nstep(imap),0)
4829         if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then
4830           write (iout,'(a)') &
4831            'Illegal boundary and/or step size specification in MAP.'
4832           stop 'Illegal boundary and/or step size specification in MAP.'
4833         endif
4834       enddo ! imap
4835       return
4836       end subroutine map_read
4837 !-----------------------------------------------------------------------------
4838       subroutine csaread
4839
4840       use control_data, only: vdisulf
4841       use csa_data
4842 !      implicit real*8 (a-h,o-z)
4843 !      include 'DIMENSIONS'
4844 !      include 'COMMON.IOUNITS'
4845 !      include 'COMMON.GEO'
4846 !      include 'COMMON.CSA'
4847 !      include 'COMMON.BANK'
4848 !      include 'COMMON.CONTROL'
4849 !      character(len=80) :: ucase
4850       character(len=620) :: mcmcard
4851 !el local variables
4852 !     integer :: ntf,ik,iw_pdb
4853 !     real(kind=8) :: var,ene
4854
4855       call card_concat(mcmcard,.true.)
4856
4857       call readi(mcmcard,'NCONF',nconf,50)
4858       call readi(mcmcard,'NADD',nadd,0)
4859       call readi(mcmcard,'JSTART',jstart,1)
4860       call readi(mcmcard,'JEND',jend,1)
4861       call readi(mcmcard,'NSTMAX',nstmax,500000)
4862       call readi(mcmcard,'N0',n0,1)
4863       call readi(mcmcard,'N1',n1,6)
4864       call readi(mcmcard,'N2',n2,4)
4865       call readi(mcmcard,'N3',n3,0)
4866       call readi(mcmcard,'N4',n4,0)
4867       call readi(mcmcard,'N5',n5,0)
4868       call readi(mcmcard,'N6',n6,10)
4869       call readi(mcmcard,'N7',n7,0)
4870       call readi(mcmcard,'N8',n8,0)
4871       call readi(mcmcard,'N9',n9,0)
4872       call readi(mcmcard,'N14',n14,0)
4873       call readi(mcmcard,'N15',n15,0)
4874       call readi(mcmcard,'N16',n16,0)
4875       call readi(mcmcard,'N17',n17,0)
4876       call readi(mcmcard,'N18',n18,0)
4877
4878       vdisulf=(index(mcmcard,'DYNSS').gt.0)
4879
4880       call readi(mcmcard,'NDIFF',ndiff,2)
4881       call reada(mcmcard,'DIFFCUT',diffcut,0.0d0)
4882       call readi(mcmcard,'IS1',is1,1)
4883       call readi(mcmcard,'IS2',is2,8)
4884       call readi(mcmcard,'NRAN0',nran0,4)
4885       call readi(mcmcard,'NRAN1',nran1,2)
4886       call readi(mcmcard,'IRR',irr,1)
4887       call readi(mcmcard,'NSEED',nseed,20)
4888       call readi(mcmcard,'NTOTAL',ntotal,10000)
4889       call reada(mcmcard,'CUT1',cut1,2.0d0)
4890       call reada(mcmcard,'CUT2',cut2,5.0d0)
4891       call reada(mcmcard,'ESTOP',estop,-3000.0d0)
4892       call readi(mcmcard,'ICMAX',icmax,3)
4893       call readi(mcmcard,'IRESTART',irestart,0)
4894 !!bankt      call readi(mcmcard,'NBANKTM',ntbankm,0)
4895       ntbankm=0
4896 !!bankt
4897       call reada(mcmcard,'DELE',dele,20.0d0)
4898       call reada(mcmcard,'DIFCUT',difcut,720.0d0)
4899       call readi(mcmcard,'IREF',iref,0)
4900       call reada(mcmcard,'RMSCUT',rmscut,4.0d0)
4901       call reada(mcmcard,'PNCCUT',pnccut,0.5d0)
4902       call readi(mcmcard,'NCONF_IN',nconf_in,0)
4903       call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0)
4904       write (iout,*) "NCONF_IN",nconf_in
4905       return
4906       end subroutine csaread
4907 !-----------------------------------------------------------------------------
4908       subroutine mcmread
4909
4910       use mcm_data
4911       use control_data, only: MaxMoveType
4912       use MD_data
4913       use minim_data
4914 !      implicit real*8 (a-h,o-z)
4915 !      include 'DIMENSIONS'
4916 !      include 'COMMON.MCM'
4917 !      include 'COMMON.MCE'
4918 !      include 'COMMON.IOUNITS'
4919 !      character(len=80) :: ucase
4920       character(len=320) :: mcmcard
4921 !el local variables
4922       integer :: i
4923 !     real(kind=8) :: var,ene
4924
4925       call card_concat(mcmcard,.true.)
4926       call readi(mcmcard,'MAXACC',maxacc,100)
4927       call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000)
4928       call readi(mcmcard,'MAXTRIAL',maxtrial,100)
4929       call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000)
4930       call readi(mcmcard,'MAXREPM',maxrepm,200)
4931       call reada(mcmcard,'RANFRACT',RanFract,0.5D0)
4932       call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0)
4933       call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3)
4934       call reada(mcmcard,'E_UP',e_up,5.0D0)
4935       call reada(mcmcard,'DELTE',delte,0.1D0)
4936       call readi(mcmcard,'NSWEEP',nsweep,5)
4937       call readi(mcmcard,'NSTEPH',nsteph,0)
4938       call readi(mcmcard,'NSTEPC',nstepc,0)
4939       call reada(mcmcard,'TMIN',tmin,298.0D0)
4940       call reada(mcmcard,'TMAX',tmax,298.0D0)
4941       call readi(mcmcard,'NWINDOW',nwindow,0)
4942       call readi(mcmcard,'PRINT_MC',print_mc,0)
4943       print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0)
4944       print_int=(index(mcmcard,'NO_PRINT_INT').le.0)
4945       ent_read=(index(mcmcard,'ENT_READ').gt.0)
4946       call readi(mcmcard,'SAVE_FREQ',save_frequency,1000)
4947       call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000)
4948       call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000)
4949       call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000)
4950       call readi(mcmcard,'PRINT_FREQ',print_freq,1000)
4951       if (nwindow.gt.0) then
4952         allocate(winstart(nwindow))     !!el (maxres)
4953         allocate(winend(nwindow))       !!el
4954         allocate(winlen(nwindow))       !!el
4955         read (inp,*) (winstart(i),winend(i),i=1,nwindow)
4956         do i=1,nwindow
4957           winlen(i)=winend(i)-winstart(i)+1
4958         enddo
4959       endif
4960       if (tmax.lt.tmin) tmax=tmin
4961       if (tmax.eq.tmin) then
4962         nstepc=0
4963         nsteph=0
4964       endif
4965       if (nstepc.gt.0 .and. nsteph.gt.0) then
4966         tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0))
4967         tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0))
4968       endif
4969       allocate(sumpro_type(0:MaxMoveType)) !(0:MaxMoveType)
4970 ! Probabilities of different move types
4971       sumpro_type(0)=0.0D0
4972       call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0)
4973       call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0)
4974       sumpro_type(2)=sumpro_type(1)+sumpro_type(2)
4975       call reada(mcmcard,'THETA'     ,sumpro_type(3),0.0d0)
4976       sumpro_type(3)=sumpro_type(2)+sumpro_type(3)
4977       call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0)
4978       sumpro_type(4)=sumpro_type(3)+sumpro_type(4)
4979       do i=1,MaxMoveType
4980         print *,'i',i,' sumprotype',sumpro_type(i)
4981         sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType)
4982         print *,'i',i,' sumprotype',sumpro_type(i)
4983       enddo
4984       return
4985       end subroutine mcmread
4986 !-----------------------------------------------------------------------------
4987       subroutine read_minim
4988
4989       use minim_data
4990 !      implicit real*8 (a-h,o-z)
4991 !      include 'DIMENSIONS'
4992 !      include 'COMMON.MINIM'
4993 !      include 'COMMON.IOUNITS'
4994 !      character(len=80) :: ucase
4995       character(len=320) :: minimcard
4996 !el local variables
4997 !     integer :: ntf,ik,iw_pdb
4998 !     real(kind=8) :: var,ene
4999
5000       call card_concat(minimcard,.true.)
5001       call readi(minimcard,'MAXMIN',maxmin,2000)
5002       call readi(minimcard,'MAXFUN',maxfun,5000)
5003       call readi(minimcard,'MINMIN',minmin,maxmin)
5004       call readi(minimcard,'MINFUN',minfun,maxmin)
5005       call reada(minimcard,'TOLF',tolf,1.0D-2)
5006       call reada(minimcard,'RTOLF',rtolf,1.0D-4)
5007       print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1)
5008       print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1)
5009       print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1)
5010       write (iout,'(/80(1h*)/20x,a/80(1h*))') &
5011                'Options in energy minimization:'
5012       write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') &
5013        'MaxMin:',MaxMin,' MaxFun:',MaxFun,&
5014        'MinMin:',MinMin,' MinFun:',MinFun,&
5015        ' TolF:',TolF,' RTolF:',RTolF
5016       return
5017       end subroutine read_minim
5018 !-----------------------------------------------------------------------------
5019       subroutine openunits
5020
5021       use MD_data, only: usampl
5022       use csa_data
5023       use MPI_data
5024       use control_data, only:out1file
5025       use control, only: getenv_loc
5026 !      implicit real*8 (a-h,o-z)
5027 !      include 'DIMENSIONS'
5028 #ifdef MPI
5029       include 'mpif.h'
5030       character(len=16) :: form,nodename
5031       integer :: nodelen,ierror,npos
5032 #endif
5033 !      include 'COMMON.SETUP'
5034 !      include 'COMMON.IOUNITS'
5035 !      include 'COMMON.MD'
5036 !      include 'COMMON.CONTROL'
5037       integer :: lenpre,lenpot,lentmp   !,ilen
5038 !el      external ilen
5039       character(len=3) :: out1file_text !,ucase
5040       character(len=3) :: ll
5041 !el      external ucase
5042 !el local variables
5043 !     integer :: ntf,ik,iw_pdb
5044 !     real(kind=8) :: var,ene
5045 !
5046 !      print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits"
5047       call getenv_loc("PREFIX",prefix)
5048       pref_orig = prefix
5049       call getenv_loc("POT",pot)
5050       call getenv_loc("DIRTMP",tmpdir)
5051       call getenv_loc("CURDIR",curdir)
5052       call getenv_loc("OUT1FILE",out1file_text)
5053 !      print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV"
5054       out1file_text=ucase(out1file_text)
5055       if (out1file_text(1:1).eq."Y") then
5056         out1file=.true.
5057       else
5058         out1file=fg_rank.gt.0
5059       endif
5060       lenpre=ilen(prefix)
5061       lenpot=ilen(pot)
5062       lentmp=ilen(tmpdir)
5063       if (lentmp.gt.0) then
5064           write (*,'(80(1h!))')
5065           write (*,'(a,19x,a,19x,a)') "!","  A T T E N T I O N  ","!"
5066           write (*,'(80(1h!))')
5067           write (*,*)"All output files will be on node /tmp directory."
5068 #ifdef MPI
5069         call  MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR )
5070         if (me.eq.king) then
5071           write (*,*) "The master node is ",nodename
5072         else if (fg_rank.eq.0) then
5073           write (*,*) "I am the CG slave node ",nodename
5074         else
5075           write (*,*) "I am the FG slave node ",nodename
5076         endif
5077 #endif
5078         PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre)
5079         lenpre = lentmp+lenpre+1
5080       endif
5081       entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr'
5082 ! Get the names and open the input files
5083 #if defined(WINIFL) || defined(WINPGI)
5084       open(1,file=pref_orig(:ilen(pref_orig))// &
5085         '.inp',status='old',readonly,shared)
5086        open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5087 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5088 ! Get parameter filenames and open the parameter files.
5089       call getenv_loc('BONDPAR',bondname)
5090       open (ibond,file=bondname,status='old',readonly,shared)
5091       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5092       open (ibond_nucl,file=bondname_nucl,status='old',readonly,shared)
5093       call getenv_loc('THETPAR',thetname)
5094       open (ithep,file=thetname,status='old',readonly,shared)
5095       call getenv_loc('ROTPAR',rotname)
5096       open (irotam,file=rotname,status='old',readonly,shared)
5097       call getenv_loc('TORPAR',torname)
5098       open (itorp,file=torname,status='old',readonly,shared)
5099       call getenv_loc('TORDPAR',tordname)
5100       open (itordp,file=tordname,status='old',readonly,shared)
5101       call getenv_loc('FOURIER',fouriername)
5102       open (ifourier,file=fouriername,status='old',readonly,shared)
5103       call getenv_loc('ELEPAR',elename)
5104       open (ielep,file=elename,status='old',readonly,shared)
5105       call getenv_loc('SIDEPAR',sidename)
5106       open (isidep,file=sidename,status='old',readonly,shared)
5107
5108       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5109       open (ithep_nucl,file=thetname_nucl,status='old',readonly,shared)
5110       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5111       open (irotam_nucl,file=rotname_nucl,status='old',readonly,shared)
5112       call getenv_loc('TORPAR_NUCL',torname_nucl)
5113       open (itorp_nucl,file=torname_nucl,status='old',readonly,shared)
5114       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5115       open (itordp_nucl,file=tordname_nucl,status='old',readonly,shared)
5116       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5117       open (isidep_nucl,file=sidename_nucl,status='old',readonly,shared)
5118
5119
5120 #elif (defined CRAY) || (defined AIX)
5121       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
5122         action='read')
5123 !      print *,"Processor",myrank," opened file 1"
5124       open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5125 !      print *,"Processor",myrank," opened file 9"
5126 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5127 ! Get parameter filenames and open the parameter files.
5128       call getenv_loc('BONDPAR',bondname)
5129       open (ibond,file=bondname,status='old',action='read')
5130       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5131       open (ibond_nucl,file=bondname_nucl,status='old',action='read')
5132
5133 !      print *,"Processor",myrank," opened file IBOND"
5134       call getenv_loc('THETPAR',thetname)
5135       open (ithep,file=thetname,status='old',action='read')
5136 !      print *,"Processor",myrank," opened file ITHEP"
5137       call getenv_loc('ROTPAR',rotname)
5138       open (irotam,file=rotname,status='old',action='read')
5139 !      print *,"Processor",myrank," opened file IROTAM"
5140       call getenv_loc('TORPAR',torname)
5141       open (itorp,file=torname,status='old',action='read')
5142 !      print *,"Processor",myrank," opened file ITORP"
5143       call getenv_loc('TORDPAR',tordname)
5144       open (itordp,file=tordname,status='old',action='read')
5145 !      print *,"Processor",myrank," opened file ITORDP"
5146       call getenv_loc('SCCORPAR',sccorname)
5147       open (isccor,file=sccorname,status='old',action='read')
5148 !      print *,"Processor",myrank," opened file ISCCOR"
5149       call getenv_loc('FOURIER',fouriername)
5150       open (ifourier,file=fouriername,status='old',action='read')
5151 !      print *,"Processor",myrank," opened file IFOURIER"
5152       call getenv_loc('ELEPAR',elename)
5153       open (ielep,file=elename,status='old',action='read')
5154 !      print *,"Processor",myrank," opened file IELEP"
5155       call getenv_loc('SIDEPAR',sidename)
5156       open (isidep,file=sidename,status='old',action='read')
5157
5158       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5159       open (ithep_nucl,file=thetname_nucl,status='old',action='read')
5160       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5161       open (irotam_nucl,file=rotname_nucl,status='old',action='read')
5162       call getenv_loc('TORPAR_NUCL',torname_nucl)
5163       open (itorp_nucl,file=torname_nucl,status='old',action='read')
5164       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5165       open (itordp_nucl,file=tordname_nucl,status='old',action='read')
5166       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5167       open (isidep_nucl,file=sidename_nucl,status='old',action='read')
5168
5169       call getenv_loc('LIPTRANPAR',liptranname)
5170       open (iliptranpar,file=liptranname,status='old',action='read')
5171       call getenv_loc('TUBEPAR',tubename)
5172       open (itube,file=tubename,status='old',action='read')
5173       call getenv_loc('IONPAR',ionname)
5174       open (iion,file=ionname,status='old',action='read')
5175
5176 !      print *,"Processor",myrank," opened file ISIDEP"
5177 !      print *,"Processor",myrank," opened parameter files"
5178 #elif (defined G77)
5179       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old')
5180       open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5181 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5182 ! Get parameter filenames and open the parameter files.
5183       call getenv_loc('BONDPAR',bondname)
5184       open (ibond,file=bondname,status='old')
5185       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5186       open (ibond_nucl,file=bondname_nucl,status='old')
5187
5188       call getenv_loc('THETPAR',thetname)
5189       open (ithep,file=thetname,status='old')
5190       call getenv_loc('ROTPAR',rotname)
5191       open (irotam,file=rotname,status='old')
5192       call getenv_loc('TORPAR',torname)
5193       open (itorp,file=torname,status='old')
5194       call getenv_loc('TORDPAR',tordname)
5195       open (itordp,file=tordname,status='old')
5196       call getenv_loc('SCCORPAR',sccorname)
5197       open (isccor,file=sccorname,status='old')
5198       call getenv_loc('FOURIER',fouriername)
5199       open (ifourier,file=fouriername,status='old')
5200       call getenv_loc('ELEPAR',elename)
5201       open (ielep,file=elename,status='old')
5202       call getenv_loc('SIDEPAR',sidename)
5203       open (isidep,file=sidename,status='old')
5204
5205       open (ithep_nucl,file=thetname_nucl,status='old')
5206       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5207       open (irotam_nucl,file=rotname_nucl,status='old')
5208       call getenv_loc('TORPAR_NUCL',torname_nucl)
5209       open (itorp_nucl,file=torname_nucl,status='old')
5210       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5211       open (itordp_nucl,file=tordname_nucl,status='old')
5212       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5213       open (isidep_nucl,file=sidename_nucl,status='old')
5214
5215       call getenv_loc('LIPTRANPAR',liptranname)
5216       open (iliptranpar,file=liptranname,status='old')
5217       call getenv_loc('TUBEPAR',tubename)
5218       open (itube,file=tubename,status='old')
5219       call getenv_loc('IONPAR',ionname)
5220       open (iion,file=ionname,status='old')
5221 #else
5222       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
5223         readonly)
5224        open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5225 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5226 ! Get parameter filenames and open the parameter files.
5227       call getenv_loc('BONDPAR',bondname)
5228       open (ibond,file=bondname,status='old',action='read')
5229       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5230       open (ibond_nucl,file=bondname_nucl,status='old',action='read')
5231       call getenv_loc('THETPAR',thetname)
5232       open (ithep,file=thetname,status='old',action='read')
5233       call getenv_loc('ROTPAR',rotname)
5234       open (irotam,file=rotname,status='old',action='read')
5235       call getenv_loc('TORPAR',torname)
5236       open (itorp,file=torname,status='old',action='read')
5237       call getenv_loc('TORDPAR',tordname)
5238       open (itordp,file=tordname,status='old',action='read')
5239       call getenv_loc('SCCORPAR',sccorname)
5240       open (isccor,file=sccorname,status='old',action='read')
5241 #ifndef CRYST_THETA
5242       call getenv_loc('THETPARPDB',thetname_pdb)
5243       print *,"thetname_pdb ",thetname_pdb
5244       open (ithep_pdb,file=thetname_pdb,status='old',action='read')
5245       print *,ithep_pdb," opened"
5246 #endif
5247       call getenv_loc('FOURIER',fouriername)
5248       open (ifourier,file=fouriername,status='old',readonly)
5249       call getenv_loc('ELEPAR',elename)
5250       open (ielep,file=elename,status='old',readonly)
5251       call getenv_loc('SIDEPAR',sidename)
5252       open (isidep,file=sidename,status='old',readonly)
5253
5254       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5255       open (ithep_nucl,file=thetname_nucl,status='old',action='read')
5256       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5257       open (irotam_nucl,file=rotname_nucl,status='old',action='read')
5258       call getenv_loc('TORPAR_NUCL',torname_nucl)
5259       open (itorp_nucl,file=torname_nucl,status='old',action='read')
5260       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5261       open (itordp_nucl,file=tordname_nucl,status='old',action='read')
5262       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5263       open (isidep_nucl,file=sidename_nucl,status='old',action='read')
5264       call getenv_loc('SIDEPAR_SCBASE',sidename_scbase)
5265       open (isidep_scbase,file=sidename_scbase,status='old',action='read')
5266       call getenv_loc('PEPPAR_PEPBASE',pepname_pepbase)
5267       open (isidep_pepbase,file=pepname_pepbase,status='old',action='read')
5268       call getenv_loc('SCPAR_PHOSPH',pepname_scpho)
5269       open (isidep_scpho,file=pepname_scpho,status='old',action='read')
5270       call getenv_loc('PEPPAR_PHOSPH',pepname_peppho)
5271       open (isidep_peppho,file=pepname_peppho,status='old',action='read')
5272
5273
5274       call getenv_loc('LIPTRANPAR',liptranname)
5275       open (iliptranpar,file=liptranname,status='old',action='read')
5276       call getenv_loc('TUBEPAR',tubename)
5277       open (itube,file=tubename,status='old',action='read')
5278       call getenv_loc('IONPAR',ionname)
5279       open (iion,file=ionname,status='old',action='read')
5280
5281 #ifndef CRYST_SC
5282       call getenv_loc('ROTPARPDB',rotname_pdb)
5283       open (irotam_pdb,file=rotname_pdb,status='old',action='read')
5284 #endif
5285 #endif
5286       call getenv_loc('SCPPAR_NUCL',scpname_nucl)
5287 #if defined(WINIFL) || defined(WINPGI)
5288       open (iscpp_nucl,file=scpname_nucl,status='old',readonly,shared)
5289 #elif (defined CRAY)  || (defined AIX)
5290       open (iscpp_nucl,file=scpname_nucl,status='old',action='read')
5291 #elif (defined G77)
5292       open (iscpp_nucl,file=scpname_nucl,status='old')
5293 #else
5294       open (iscpp_nucl,file=scpname_nucl,status='old',action='read')
5295 #endif
5296
5297 #ifndef OLDSCP
5298 !
5299 ! 8/9/01 In the newest version SCp interaction constants are read from a file
5300 ! Use -DOLDSCP to use hard-coded constants instead.
5301 !
5302       call getenv_loc('SCPPAR',scpname)
5303 #if defined(WINIFL) || defined(WINPGI)
5304       open (iscpp,file=scpname,status='old',readonly,shared)
5305 #elif (defined CRAY)  || (defined AIX)
5306       open (iscpp,file=scpname,status='old',action='read')
5307 #elif (defined G77)
5308       open (iscpp,file=scpname,status='old')
5309 #else
5310       open (iscpp,file=scpname,status='old',action='read')
5311 #endif
5312 #endif
5313       call getenv_loc('PATTERN',patname)
5314 #if defined(WINIFL) || defined(WINPGI)
5315       open (icbase,file=patname,status='old',readonly,shared)
5316 #elif (defined CRAY)  || (defined AIX)
5317       open (icbase,file=patname,status='old',action='read')
5318 #elif (defined G77)
5319       open (icbase,file=patname,status='old')
5320 #else
5321       open (icbase,file=patname,status='old',action='read')
5322 #endif
5323 #ifdef MPI
5324 ! Open output file only for CG processes
5325 !      print *,"Processor",myrank," fg_rank",fg_rank
5326       if (fg_rank.eq.0) then
5327
5328       if (nodes.eq.1) then
5329         npos=3
5330       else
5331         npos = dlog10(dfloat(nodes-1))+1
5332       endif
5333       if (npos.lt.3) npos=3
5334       write (liczba,'(i1)') npos
5335       form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) &
5336         //')'
5337       write (liczba,form) me
5338       outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// &
5339         liczba(:ilen(liczba))
5340       intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) &
5341         //'.int'
5342       pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) &
5343         //'.pdb'
5344       mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// &
5345         liczba(:ilen(liczba))//'.mol2'
5346       statname=prefix(:lenpre)//'_'//pot(:lenpot)// &
5347         liczba(:ilen(liczba))//'.stat'
5348       if (lentmp.gt.0) &
5349         call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) &
5350             //liczba(:ilen(liczba))//'.stat')
5351       rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) &
5352         //'.rst'
5353       if(usampl) then
5354           qname=prefix(:lenpre)//'_'//pot(:lenpot)// &
5355        liczba(:ilen(liczba))//'.const'
5356       endif
5357
5358       endif
5359 #else
5360       outname=prefix(:lenpre)//'.out_'//pot(:lenpot)
5361       intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int'
5362       pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb'
5363       mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2'
5364       statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat'
5365       if (lentmp.gt.0) &
5366         call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)// &
5367           '.stat')
5368       rest2name=prefix(:ilen(prefix))//'.rst'
5369       if(usampl) then
5370          qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const'
5371       endif
5372 #endif
5373 #if defined(AIX) || defined(PGI)
5374       if (me.eq.king .or. .not. out1file) &
5375          open(iout,file=outname,status='unknown')
5376 #ifdef DEBUG
5377       if (fg_rank.gt.0) then
5378         write (liczba,'(i3.3)') myrank/nfgtasks
5379         write (ll,'(bz,i3.3)') fg_rank
5380         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,&
5381          status='unknown')
5382       endif
5383 #endif
5384       if(me.eq.king) then
5385        open(igeom,file=intname,status='unknown',position='append')
5386        open(ipdb,file=pdbname,status='unknown')
5387        open(imol2,file=mol2name,status='unknown')
5388        open(istat,file=statname,status='unknown',position='append')
5389       else
5390 !1out       open(iout,file=outname,status='unknown')
5391       endif
5392 #else
5393       if (me.eq.king .or. .not.out1file) &
5394           open(iout,file=outname,status='unknown')
5395 #ifdef DEBUG
5396       if (fg_rank.gt.0) then
5397         write (liczba,'(i3.3)') myrank/nfgtasks
5398         write (ll,'(bz,i3.3)') fg_rank
5399         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,&
5400          status='unknown')
5401       endif
5402 #endif
5403       if(me.eq.king) then
5404        open(igeom,file=intname,status='unknown',access='append')
5405        open(ipdb,file=pdbname,status='unknown')
5406        open(imol2,file=mol2name,status='unknown')
5407        open(istat,file=statname,status='unknown',access='append')
5408       else
5409 !1out       open(iout,file=outname,status='unknown')
5410       endif
5411 #endif
5412       csa_rbank=prefix(:lenpre)//'.CSA.rbank'
5413       csa_seed=prefix(:lenpre)//'.CSA.seed'
5414       csa_history=prefix(:lenpre)//'.CSA.history'
5415       csa_bank=prefix(:lenpre)//'.CSA.bank'
5416       csa_bank1=prefix(:lenpre)//'.CSA.bank1'
5417       csa_alpha=prefix(:lenpre)//'.CSA.alpha'
5418       csa_alpha1=prefix(:lenpre)//'.CSA.alpha1'
5419 !!bankt      csa_bankt=prefix(:lenpre)//'.CSA.bankt'
5420       csa_int=prefix(:lenpre)//'.int'
5421       csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized'
5422       csa_native_int=prefix(:lenpre)//'.CSA.native.int'
5423       csa_in=prefix(:lenpre)//'.CSA.in'
5424 !      print *,"Processor",myrank,"fg_rank",fg_rank," opened files"
5425 ! Write file names
5426       if (me.eq.king)then
5427       write (iout,'(80(1h-))')
5428       write (iout,'(30x,a)') "FILE ASSIGNMENT"
5429       write (iout,'(80(1h-))')
5430       write (iout,*) "Input file                      : ",&
5431         pref_orig(:ilen(pref_orig))//'.inp'
5432       write (iout,*) "Output file                     : ",&
5433         outname(:ilen(outname))
5434       write (iout,*)
5435       write (iout,*) "Sidechain potential file        : ",&
5436         sidename(:ilen(sidename))
5437 #ifndef OLDSCP
5438       write (iout,*) "SCp potential file              : ",&
5439         scpname(:ilen(scpname))
5440 #endif
5441       write (iout,*) "Electrostatic potential file    : ",&
5442         elename(:ilen(elename))
5443       write (iout,*) "Cumulant coefficient file       : ",&
5444         fouriername(:ilen(fouriername))
5445       write (iout,*) "Torsional parameter file        : ",&
5446         torname(:ilen(torname))
5447       write (iout,*) "Double torsional parameter file : ",&
5448         tordname(:ilen(tordname))
5449       write (iout,*) "SCCOR parameter file : ",&
5450         sccorname(:ilen(sccorname))
5451       write (iout,*) "Bond & inertia constant file    : ",&
5452         bondname(:ilen(bondname))
5453       write (iout,*) "Bending parameter file          : ",&
5454         thetname(:ilen(thetname))
5455       write (iout,*) "Rotamer parameter file          : ",&
5456         rotname(:ilen(rotname))
5457 !el----
5458 #ifndef CRYST_THETA
5459       write (iout,*) "Thetpdb parameter file          : ",&
5460         thetname_pdb(:ilen(thetname_pdb))
5461 #endif
5462 !el
5463       write (iout,*) "Threading database              : ",&
5464         patname(:ilen(patname))
5465       if (lentmp.ne.0) &
5466       write (iout,*)" DIRTMP                          : ",&
5467         tmpdir(:lentmp)
5468       write (iout,'(80(1h-))')
5469       endif
5470       return
5471       end subroutine openunits
5472 !-----------------------------------------------------------------------------
5473       subroutine readrst
5474
5475       use geometry_data, only: nres,dc
5476       use MD_data
5477 !      implicit real*8 (a-h,o-z)
5478 !      include 'DIMENSIONS'
5479 !      include 'COMMON.CHAIN'
5480 !      include 'COMMON.IOUNITS'
5481 !      include 'COMMON.MD'
5482 !el local variables
5483       integer ::i,j
5484 !     real(kind=8) :: var,ene
5485
5486       open(irest2,file=rest2name,status='unknown')
5487       read(irest2,*) totT,EK,potE,totE,t_bath
5488       totTafm=totT
5489 !      do i=1,2*nres
5490 ! AL 4/17/17: Now reading d_t(0,:) too
5491       do i=0,2*nres
5492          read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
5493       enddo
5494 !      do i=1,2*nres
5495 ! AL 4/17/17: Now reading d_c(0,:) too
5496       do i=0,2*nres
5497          read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
5498       enddo
5499       if(usampl) then
5500              read (irest2,*) iset
5501       endif
5502       close(irest2)
5503       return
5504       end subroutine readrst
5505 !-----------------------------------------------------------------------------
5506       subroutine read_fragments
5507
5508       use energy_data
5509 !      use geometry
5510       use control_data, only:out1file
5511       use MD_data
5512       use MPI_data
5513 !      implicit real*8 (a-h,o-z)
5514 !      include 'DIMENSIONS'
5515 #ifdef MPI
5516       include 'mpif.h'
5517 #endif
5518 !      include 'COMMON.SETUP'
5519 !      include 'COMMON.CHAIN'
5520 !      include 'COMMON.IOUNITS'
5521 !      include 'COMMON.MD'
5522 !      include 'COMMON.CONTROL'
5523 !el local variables
5524       integer :: i
5525 !     real(kind=8) :: var,ene
5526
5527       read(inp,*) nset,nfrag,npair,nfrag_back
5528
5529 !el from module energy
5530 !      if(.not.allocated(mset)) allocate(mset(nset))  !(maxprocs/20)
5531       if(.not.allocated(wfrag_back)) then
5532         allocate(wfrag_back(3,nfrag_back,nset)) !(3,maxfrag_back,maxprocs/20)
5533         allocate(ifrag_back(3,nfrag_back,nset)) !(3,maxfrag_back,maxprocs/20)
5534
5535         allocate(qinfrag(nfrag,nset),wfrag(nfrag,nset)) !(50,maxprocs/20)
5536         allocate(ifrag(2,nfrag,nset))  !(2,50,maxprocs/20)
5537
5538         allocate(qinpair(npair,nset),wpair(npair,nset)) !(100,maxprocs/20)
5539         allocate(ipair(2,npair,nset))  !(2,100,maxprocs/20)
5540       endif
5541
5542       if(me.eq.king.or..not.out1file) &
5543        write(iout,*) "nset",nset," nfrag",nfrag," npair",npair,&
5544         " nfrag_back",nfrag_back
5545       do iset=1,nset
5546          read(inp,*) mset(iset)
5547        do i=1,nfrag
5548          read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset),&
5549            qinfrag(i,iset)
5550          if(me.eq.king.or..not.out1file) &
5551           write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset),&
5552            ifrag(2,i,iset), qinfrag(i,iset)
5553        enddo
5554        do i=1,npair
5555         read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset),&
5556           qinpair(i,iset)
5557         if(me.eq.king.or..not.out1file) &
5558          write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset),&
5559           ipair(2,i,iset), qinpair(i,iset)
5560        enddo
5561        do i=1,nfrag_back
5562         read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset),&
5563            wfrag_back(3,i,iset),&
5564            ifrag_back(1,i,iset),ifrag_back(2,i,iset)
5565         if(me.eq.king.or..not.out1file) &
5566          write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset),&
5567          wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset)
5568        enddo
5569       enddo
5570       return
5571       end subroutine read_fragments
5572 !-----------------------------------------------------------------------------
5573 ! shift.F       io_csa
5574 !-----------------------------------------------------------------------------
5575       subroutine csa_read
5576
5577       use csa_data
5578 !      implicit real*8 (a-h,o-z)
5579 !      include 'DIMENSIONS'
5580 !      include 'COMMON.CSA'
5581 !      include 'COMMON.BANK'
5582 !      include 'COMMON.IOUNITS'
5583 !el local variables
5584 !     integer :: ntf,ik,iw_pdb
5585 !     real(kind=8) :: var,ene
5586
5587       open(icsa_in,file=csa_in,status="old",err=100)
5588        read(icsa_in,*) nconf
5589        read(icsa_in,*) jstart,jend
5590        read(icsa_in,*) nstmax
5591        read(icsa_in,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5592        read(icsa_in,*) nran0,nran1,irr
5593        read(icsa_in,*) nseed
5594        read(icsa_in,*) ntotal,cut1,cut2
5595        read(icsa_in,*) estop
5596        read(icsa_in,*) icmax,irestart
5597        read(icsa_in,*) ntbankm,dele,difcut
5598        read(icsa_in,*) iref,rmscut,pnccut
5599        read(icsa_in,*) ndiff
5600       close(icsa_in)
5601
5602       return
5603
5604  100  continue
5605       return
5606       end subroutine csa_read
5607 !-----------------------------------------------------------------------------
5608       subroutine initial_write
5609
5610       use csa_data
5611 !      implicit real*8 (a-h,o-z)
5612 !      include 'DIMENSIONS'
5613 !      include 'COMMON.CSA'
5614 !      include 'COMMON.BANK'
5615 !      include 'COMMON.IOUNITS'
5616 !el local variables
5617 !     integer :: ntf,ik,iw_pdb
5618 !     real(kind=8) :: var,ene
5619
5620       open(icsa_seed,file=csa_seed,status="unknown")
5621        write(icsa_seed,*) "seed"
5622       close(31)
5623 #if defined(AIX) || defined(PGI)
5624        open(icsa_history,file=csa_history,status="unknown",&
5625         position="append")
5626 #else
5627        open(icsa_history,file=csa_history,status="unknown",&
5628         access="append")
5629 #endif
5630        write(icsa_history,*) nconf
5631        write(icsa_history,*) jstart,jend
5632        write(icsa_history,*) nstmax
5633        write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5634        write(icsa_history,*) nran0,nran1,irr
5635        write(icsa_history,*) nseed
5636        write(icsa_history,*) ntotal,cut1,cut2
5637        write(icsa_history,*) estop
5638        write(icsa_history,*) icmax,irestart
5639        write(icsa_history,*) ntbankm,dele,difcut
5640        write(icsa_history,*) iref,rmscut,pnccut
5641        write(icsa_history,*) ndiff
5642
5643        write(icsa_history,*)
5644       close(icsa_history)
5645
5646       open(icsa_bank1,file=csa_bank1,status="unknown")
5647        write(icsa_bank1,*) 0
5648       close(icsa_bank1)
5649
5650       return
5651       end subroutine initial_write
5652 !-----------------------------------------------------------------------------
5653       subroutine restart_write
5654
5655       use csa_data
5656 !      implicit real*8 (a-h,o-z)
5657 !      include 'DIMENSIONS'
5658 !      include 'COMMON.IOUNITS'
5659 !      include 'COMMON.CSA'
5660 !      include 'COMMON.BANK'
5661 !el local variables
5662 !     integer :: ntf,ik,iw_pdb
5663 !     real(kind=8) :: var,ene
5664
5665 #if defined(AIX) || defined(PGI)
5666        open(icsa_history,file=csa_history,position="append")
5667 #else
5668        open(icsa_history,file=csa_history,access="append")
5669 #endif
5670        write(icsa_history,*)
5671        write(icsa_history,*) "This is restart"
5672        write(icsa_history,*)
5673        write(icsa_history,*) nconf
5674        write(icsa_history,*) jstart,jend
5675        write(icsa_history,*) nstmax
5676        write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5677        write(icsa_history,*) nran0,nran1,irr
5678        write(icsa_history,*) nseed
5679        write(icsa_history,*) ntotal,cut1,cut2
5680        write(icsa_history,*) estop
5681        write(icsa_history,*) icmax,irestart
5682        write(icsa_history,*) ntbankm,dele,difcut
5683        write(icsa_history,*) iref,rmscut,pnccut
5684        write(icsa_history,*) ndiff
5685        write(icsa_history,*)
5686        write(icsa_history,*) "irestart is: ", irestart
5687
5688        write(icsa_history,*)
5689       close(icsa_history)
5690
5691       return
5692       end subroutine restart_write
5693 !-----------------------------------------------------------------------------
5694 ! test.F
5695 !-----------------------------------------------------------------------------
5696       subroutine write_pdb(npdb,titelloc,ee)
5697
5698 !      implicit real*8 (a-h,o-z)
5699 !      include 'DIMENSIONS'
5700 !      include 'COMMON.IOUNITS'
5701       character(len=50) :: titelloc1
5702       character*(*) :: titelloc
5703       character(len=3) :: zahl
5704       character(len=5) :: liczba5
5705       real(kind=8) :: ee
5706       integer :: npdb   !,ilen
5707 !el      external ilen
5708 !el local variables
5709       integer :: lenpre
5710 !     real(kind=8) :: var,ene
5711
5712       titelloc1=titelloc
5713       lenpre=ilen(prefix)
5714       if (npdb.lt.1000) then
5715        call numstr(npdb,zahl)
5716        open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
5717       else
5718         if (npdb.lt.10000) then
5719          write(liczba5,'(i1,i4)') 0,npdb
5720         else
5721          write(liczba5,'(i5)') npdb
5722         endif
5723         open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
5724       endif
5725       call pdbout(ee,titelloc1,ipdb)
5726       close(ipdb)
5727       return
5728       end subroutine write_pdb
5729 !-----------------------------------------------------------------------------
5730 ! thread.F
5731 !-----------------------------------------------------------------------------
5732       subroutine write_thread_summary
5733 ! Thread the sequence through a database of known structures
5734       use control_data, only: refstr
5735 !      use geometry
5736       use energy_data, only: n_ene_comp
5737       use compare_data
5738 !      implicit real*8 (a-h,o-z)
5739 !      include 'DIMENSIONS'
5740 #ifdef MPI
5741       use MPI_data      !include 'COMMON.INFO'
5742       include 'mpif.h'
5743 #endif
5744 !      include 'COMMON.CONTROL'
5745 !      include 'COMMON.CHAIN'
5746 !      include 'COMMON.DBASE'
5747 !      include 'COMMON.INTERACT'
5748 !      include 'COMMON.VAR'
5749 !      include 'COMMON.THREAD'
5750 !      include 'COMMON.FFIELD'
5751 !      include 'COMMON.SBRIDGE'
5752 !      include 'COMMON.HEADER'
5753 !      include 'COMMON.NAMES'
5754 !      include 'COMMON.IOUNITS'
5755 !      include 'COMMON.TIME1'
5756
5757       integer,dimension(maxthread) :: ip
5758       real(kind=8),dimension(0:n_ene) :: energia
5759 !el local variables
5760       integer :: i,j,ii,jj,ipj,ik,kk,ist
5761       real(kind=8) :: enet,etot,rmsnat,rms,frac,frac_nn
5762
5763       write (iout,'(30x,a/)') &
5764        '  *********** Summary threading statistics ************'
5765       write (iout,'(a)') 'Initial energies:'
5766       write (iout,'(a4,2x,a12,14a14,3a8)') &
5767        'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT',&
5768        'RMSnat','NatCONT','NNCONT','RMS'
5769 ! Energy sort patterns
5770       do i=1,nthread
5771         ip(i)=i
5772       enddo
5773       do i=1,nthread-1
5774         enet=ener(n_ene-1,ip(i))
5775         jj=i
5776         do j=i+1,nthread
5777           if (ener(n_ene-1,ip(j)).lt.enet) then
5778             jj=j
5779             enet=ener(n_ene-1,ip(j))
5780           endif
5781         enddo
5782         if (jj.ne.i) then
5783           ipj=ip(jj)
5784           ip(jj)=ip(i)
5785           ip(i)=ipj
5786         endif
5787       enddo
5788       do ik=1,nthread
5789         i=ip(ik)
5790         ii=ipatt(1,i)
5791         ist=nres_base(2,ii)+ipatt(2,i)
5792         do kk=1,n_ene_comp
5793           energia(i)=ener0(kk,i)
5794         enddo
5795         etot=ener0(n_ene_comp+1,i)
5796         rmsnat=ener0(n_ene_comp+2,i)
5797         rms=ener0(n_ene_comp+3,i)
5798         frac=ener0(n_ene_comp+4,i)
5799         frac_nn=ener0(n_ene_comp+5,i)
5800
5801         if (refstr) then
5802         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5803         i,str_nam(ii),ist+1,&
5804         (energia(print_order(kk)),kk=1,nprint_ene),&
5805         etot,rmsnat,frac,frac_nn,rms
5806         else
5807         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)') &
5808         i,str_nam(ii),ist+1,&
5809         (energia(print_order(kk)),kk=1,nprint_ene),etot
5810         endif
5811       enddo
5812       write (iout,'(//a)') 'Final energies:'
5813       write (iout,'(a4,2x,a12,17a14,3a8)') &
5814        'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT',&
5815        'RMSnat','NatCONT','NNCONT','RMS'
5816       do ik=1,nthread
5817         i=ip(ik)
5818         ii=ipatt(1,i)
5819         ist=nres_base(2,ii)+ipatt(2,i)
5820         do kk=1,n_ene_comp
5821           energia(kk)=ener(kk,ik)
5822         enddo
5823         etot=ener(n_ene_comp+1,i)
5824         rmsnat=ener(n_ene_comp+2,i)
5825         rms=ener(n_ene_comp+3,i)
5826         frac=ener(n_ene_comp+4,i)
5827         frac_nn=ener(n_ene_comp+5,i)
5828         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5829         i,str_nam(ii),ist+1,&
5830         (energia(print_order(kk)),kk=1,nprint_ene),&
5831         etot,rmsnat,frac,frac_nn,rms
5832       enddo
5833       write (iout,'(/a/)') 'IEXAM array:'
5834       write (iout,'(i5)') nexcl
5835       do i=1,nexcl
5836         write (iout,'(2i5)') iexam(1,i),iexam(2,i)
5837       enddo
5838       write (iout,'(/a,1pe14.4/a,1pe14.4/)') &
5839        'Max. time for threading step ',max_time_for_thread,&
5840        'Average time for threading step: ',ave_time_for_thread
5841       return
5842       end subroutine write_thread_summary
5843 !-----------------------------------------------------------------------------
5844       subroutine write_stat_thread(ithread,ipattern,ist)
5845
5846       use energy_data, only: n_ene_comp
5847       use compare_data
5848 !      implicit real*8 (a-h,o-z)
5849 !      include "DIMENSIONS"
5850 !      include "COMMON.CONTROL"
5851 !      include "COMMON.IOUNITS"
5852 !      include "COMMON.THREAD"
5853 !      include "COMMON.FFIELD"
5854 !      include "COMMON.DBASE"
5855 !      include "COMMON.NAMES"
5856       real(kind=8),dimension(0:n_ene) :: energia
5857 !el local variables
5858       integer :: ithread,ipattern,ist,i
5859       real(kind=8) :: etot,rmsnat,rms,frac,frac_nn
5860
5861 #if defined(AIX) || defined(PGI)
5862       open(istat,file=statname,position='append')
5863 #else
5864       open(istat,file=statname,access='append')
5865 #endif
5866       do i=1,n_ene_comp
5867         energia(i)=ener(i,ithread)
5868       enddo
5869       etot=ener(n_ene_comp+1,ithread)
5870       rmsnat=ener(n_ene_comp+2,ithread)
5871       rms=ener(n_ene_comp+3,ithread)
5872       frac=ener(n_ene_comp+4,ithread)
5873       frac_nn=ener(n_ene_comp+5,ithread)
5874       write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5875         ithread,str_nam(ipattern),ist+1,&
5876         (energia(print_order(i)),i=1,nprint_ene),&
5877         etot,rmsnat,frac,frac_nn,rms
5878       close (istat)
5879       return
5880       end subroutine write_stat_thread
5881 !-----------------------------------------------------------------------------
5882 #endif
5883 !-----------------------------------------------------------------------------
5884       end module io_config