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        dheadcat(1,1,i,j),dheadcat(1,2,i,j),dheadcat(2,1,i,j),dheadcat(2,2,i,j),&
3273        dtailcat(1,i,j),dtailcat(2,i,j), &
3274        epsheadcat(i,j),sig0headcat(i,j), &
3275 !wdipcat = w1 , w2
3276        rborncat(i,j),rborncat(j,i),(wqdipcat(k,i,j),k=1,2), &
3277        alphapolcat(i,j),alphapolcat(j,i), &
3278        (alphisocat(k,i,j),k=1,4),sigiso1cat(i,j),sigiso2cat(i,j),epsintabcat(i,j),debaykapcat(i,j)
3279 !       print *,eps(i,j),sigma(i,j),"SIGMAP",i,j,sigmap1(i,j),sigmap2(j,i)
3280        END DO
3281       END DO
3282       endif
3283
3284
3285       if(me.eq.king) then
3286       write (iout,'(/a)') "Disulfide bridge parameters:"
3287       write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
3288       write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
3289       write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
3290       write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,&
3291         ' v3ss:',v3ss
3292       endif
3293       if (shield_mode.gt.0) then
3294       pi=4.0D0*datan(1.0D0)
3295 !C VSolvSphere the volume of solving sphere
3296       print *,pi,"pi"
3297 !C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
3298 !C there will be no distinction between proline peptide group and normal peptide
3299 !C group in case of shielding parameters
3300       VSolvSphere=4.0/3.0*pi*(4.50d0)**3
3301       VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(4.50/2.0)**3
3302       write (iout,*) VSolvSphere,VSolvSphere_div
3303 !C long axis of side chain
3304       do i=1,ntyp
3305       long_r_sidechain(i)=vbldsc0(1,i)
3306 !      if (scelemode.eq.0) then
3307       short_r_sidechain(i)=sigma(i,i)/sqrt(2.0)
3308       if (short_r_sidechain(i).eq.0.0) short_r_sidechain(i)=0.2
3309 !      else
3310 !      short_r_sidechain(i)=sigma(i,i)
3311 !      endif
3312       write(iout,*) "parame for long and short axis",i,vbldsc0(1,i),&
3313          sigma0(i)
3314       enddo
3315       buff_shield=1.0d0
3316       endif
3317
3318       return
3319   111 write (iout,*) "Error reading bending energy parameters."
3320       goto 999
3321   112 write (iout,*) "Error reading rotamer energy parameters."
3322       goto 999
3323   113 write (iout,*) "Error reading torsional energy parameters."
3324       goto 999
3325   114 write (iout,*) "Error reading double torsional energy parameters."
3326       goto 999
3327   115 write (iout,*) &
3328         "Error reading cumulant (multibody energy) parameters."
3329       goto 999
3330   116 write (iout,*) "Error reading electrostatic energy parameters."
3331       goto 999
3332   117 write (iout,*) "Error reading side chain interaction parameters."
3333       goto 999
3334   118 write (iout,*) "Error reading SCp interaction parameters."
3335       goto 999
3336   119 write (iout,*) "Error reading SCCOR parameters"
3337       go to 999
3338   121 write (iout,*) "Error in Czybyshev parameters"
3339   999 continue
3340 #ifdef MPI
3341       call MPI_Finalize(Ierror)
3342 #endif
3343       stop
3344       return
3345       end subroutine parmread
3346 #endif
3347 !-----------------------------------------------------------------------------
3348 ! printmat.f
3349 !-----------------------------------------------------------------------------
3350       subroutine printmat(ldim,m,n,iout,key,a)
3351
3352       integer :: n,ldim
3353       character(len=3),dimension(n) :: key
3354       real(kind=8),dimension(ldim,n) :: a
3355 !el local variables
3356       integer :: i,j,k,m,iout,nlim
3357
3358       do 1 i=1,n,8
3359       nlim=min0(i+7,n)
3360       write (iout,1000) (key(k),k=i,nlim)
3361       write (iout,1020)
3362  1000 format (/5x,8(6x,a3))
3363  1020 format (/80(1h-)/)
3364       do 2 j=1,n
3365       write (iout,1010) key(j),(a(j,k),k=i,nlim)
3366     2 continue
3367     1 continue
3368  1010 format (a3,2x,8(f9.4))
3369       return
3370       end subroutine printmat
3371 !-----------------------------------------------------------------------------
3372 ! readpdb.F
3373 !-----------------------------------------------------------------------------
3374       subroutine readpdb
3375 ! Read the PDB file and convert the peptide geometry into virtual-chain
3376 ! geometry.
3377       use geometry_data
3378       use energy_data, only: itype,istype
3379       use control_data
3380       use compare_data
3381       use MPI_data
3382 !      use control, only: rescode,sugarcode
3383 !      implicit real*8 (a-h,o-z)
3384 !      include 'DIMENSIONS'
3385 !      include 'COMMON.LOCAL'
3386 !      include 'COMMON.VAR'
3387 !      include 'COMMON.CHAIN'
3388 !      include 'COMMON.INTERACT'
3389 !      include 'COMMON.IOUNITS'
3390 !      include 'COMMON.GEO'
3391 !      include 'COMMON.NAMES'
3392 !      include 'COMMON.CONTROL'
3393 !      include 'COMMON.DISTFIT'
3394 !      include 'COMMON.SETUP'
3395       integer :: i,j,ibeg,ishift1,ires,iii,ires_old,ishift,k!,ity!,&
3396 !        ishift_pdb
3397       logical :: lprn=.true.,fail
3398       real(kind=8),dimension(3) :: e1,e2,e3
3399       real(kind=8) :: dcj,efree_temp
3400       character(len=3) :: seq,res,res2
3401       character(len=5) :: atom
3402       character(len=80) :: card
3403       real(kind=8),dimension(3,20) :: sccor
3404       integer :: kkk,lll,icha,kupa,molecule,counter,seqalingbegin       !rescode,
3405       integer :: isugar,molecprev,firstion
3406       character*1 :: sugar
3407       real(kind=8) :: cou
3408       real(kind=8),dimension(3) :: ccc
3409 !el local varables
3410       integer,dimension(2,maxres/3) :: hfrag_alloc
3411       integer,dimension(4,maxres/3) :: bfrag_alloc
3412       real(kind=8),dimension(3,maxres2+2,maxperm) :: cref_alloc !(3,maxres2+2,maxperm)
3413       real(kind=8),dimension(:,:), allocatable  :: c_temporary
3414       integer,dimension(:,:) , allocatable  :: itype_temporary
3415       integer,dimension(:),allocatable :: istype_temp
3416       efree_temp=0.0d0
3417       ibeg=1
3418       ishift1=0
3419       ishift=0
3420       molecule=1
3421       counter=0
3422 !      write (2,*) "UNRES_PDB",unres_pdb
3423       ires=0
3424       ires_old=0
3425 #ifdef WHAM_RUN
3426       do i=1,nres
3427        do j=1,5
3428         itype(i,j)=0
3429        enddo
3430       enddo
3431 #endif
3432       nres=0
3433       iii=0
3434       lsecondary=.false.
3435       nhfrag=0
3436       nbfrag=0
3437       do j=1,5
3438        nres_molec(j)=0
3439       enddo
3440
3441
3442 !-----------------------------
3443       allocate(hfrag(2,maxres/3)) !(2,maxres/3)
3444       allocate(bfrag(4,maxres/3)) !(4,maxres/3)
3445       if(.not. allocated(istype)) allocate(istype(maxres))
3446       do i=1,100000
3447         read (ipdbin,'(a80)',end=10) card
3448        write (iout,'(a)') card
3449         if (card(:5).eq.'HELIX') then
3450           nhfrag=nhfrag+1
3451           lsecondary=.true.
3452           read(card(22:25),*) hfrag(1,nhfrag)
3453           read(card(34:37),*) hfrag(2,nhfrag)
3454         endif
3455         if (card(:5).eq.'SHEET') then
3456           nbfrag=nbfrag+1
3457           lsecondary=.true.
3458           read(card(24:26),*) bfrag(1,nbfrag)
3459           read(card(35:37),*) bfrag(2,nbfrag)
3460 !rc----------------------------------------
3461 !rc  to be corrected !!!
3462           bfrag(3,nbfrag)=bfrag(1,nbfrag)
3463           bfrag(4,nbfrag)=bfrag(2,nbfrag)
3464 !rc----------------------------------------
3465         endif
3466         if (card(:3).eq.'END') then
3467           goto 10
3468         else if (card(:3).eq.'TER') then
3469 ! End current chain
3470           ires_old=ires+2
3471           ishift=ishift+1
3472           ishift1=ishift1+1
3473           itype(ires_old,molecule)=ntyp1_molec(molecule)
3474           itype(ires_old-1,molecule)=ntyp1_molec(molecule)
3475           nres_molec(molecule)=nres_molec(molecule)+2
3476           ibeg=2
3477 !          write (iout,*) "Chain ended",ires,ishift,ires_old
3478           if (unres_pdb) then
3479             do j=1,3
3480               dc(j,ires)=sccor(j,iii)
3481             enddo
3482           else
3483             call sccenter(ires,iii,sccor)
3484 !          iii=0
3485           endif
3486           iii=0
3487         endif
3488 ! Read free energy
3489         if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
3490 ! Fish out the ATOM cards.
3491 !        write(iout,*) 'card',card(1:20)
3492 !        print *,"ATU ",card(1:6), CARD(3:6)
3493 !        print *,card
3494         if (index(card(1:4),'ATOM').gt.0) then
3495           read (card(12:16),*) atom
3496 !          write (iout,*) "! ",atom," !",ires
3497 !          if (atom.eq.'CA' .or. atom.eq.'CH3') then
3498           read (card(23:26),*) ires
3499           read (card(18:20),'(a3)') res
3500 !          write (iout,*) "ires",ires,ires-ishift+ishift1,
3501 !     &      " ires_old",ires_old
3502 !          write (iout,*) "ishift",ishift," ishift1",ishift1
3503 !          write (iout,*) "IRES",ires-ishift+ishift1,ires_old
3504           if (ires-ishift+ishift1.ne.ires_old) then
3505 ! Calculate the CM of the preceding residue.
3506 !            if (ibeg.eq.0) call sccenter(ires,iii,sccor)
3507             if (ibeg.eq.0) then
3508 !              write (iout,*) "Calculating sidechain center iii",iii
3509               if (unres_pdb) then
3510                 do j=1,3
3511                   dc(j,ires+ishift1-ishift-1)=sccor(j,iii)
3512                 enddo
3513               else
3514                 call sccenter(ires_old,iii,sccor)
3515               endif !unres_pdb
3516               iii=0
3517             endif !ind_pdb
3518 ! Start new residue.
3519             if (res.eq.'Cl-' .or. res.eq.'Na+') then
3520               ires=ires_old
3521               cycle
3522             else if (ibeg.eq.1) then
3523               write (iout,*) "BEG ires",ires
3524               ishift=ires-1
3525               if (res.ne.'GLY' .and. res.ne. 'ACE') then
3526                 ishift=ishift-1
3527                 itype(1,1)=ntyp1
3528                 nres_molec(molecule)=nres_molec(molecule)+1
3529               endif ! Gly
3530               ires=ires-ishift+ishift1
3531               ires_old=ires
3532 !              write (iout,*) "ishift",ishift," ires",ires,&
3533 !               " ires_old",ires_old
3534               ibeg=0
3535             else if (ibeg.eq.2) then
3536 ! Start a new chain
3537               ishift=-ires_old+ires-1 !!!!!
3538               ishift1=ishift1-1    !!!!!
3539 !              write (iout,*) "New chain started",ires,ishift,ishift1,"!"
3540               ires=ires-ishift+ishift1
3541 !              print *,ires,ishift,ishift1
3542               ires_old=ires
3543               ibeg=0
3544             else
3545               ishift=ishift-(ires-ishift+ishift1-ires_old-1)
3546               ires=ires-ishift+ishift1
3547               ires_old=ires
3548             endif ! Na Cl
3549 !            print *,'atom',ires,atom
3550             if (res.eq.'ACE' .or. res.eq.'NHE') then
3551               itype(ires,1)=10
3552             else
3553              if (atom.eq.'CA  '.or.atom.eq.'N   ') then
3554              molecule=1
3555               itype(ires,molecule)=rescode(ires,res,0,molecule)
3556               firstion=0
3557 !              nres_molec(molecule)=nres_molec(molecule)+1
3558             else
3559              molecule=2
3560              res2=res(2:3)
3561               itype(ires,molecule)=rescode(ires,res2,0,molecule)
3562 !              nres_molec(molecule)=nres_molec(molecule)+1
3563              read (card(19:19),'(a1)') sugar
3564              isugar=sugarcode(sugar,ires)
3565 !            if (ibeg.eq.1) then
3566 !              istype(1)=isugar
3567 !            else
3568               istype(ires)=isugar
3569 !              print *,"ires=",ires,istype(ires)
3570 !            endif
3571
3572             endif ! atom.eq.CA
3573             endif !ACE
3574           else
3575             ires=ires-ishift+ishift1
3576           endif !ires_old
3577 !          write (iout,*) "ires_old",ires_old," ires",ires
3578           if (card(27:27).eq."A" .or. card(27:27).eq."B") then
3579 !            ishift1=ishift1+1
3580           endif
3581 !          write (2,*) "ires",ires," res ",res!," ity"!,ity
3582           if (atom.eq.'CA' .or. atom.eq.'CH3' .or. &
3583              res.eq.'NHE'.and.atom(:2).eq.'HN') then
3584             read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
3585 !              print *,ires,ishift,ishift1
3586 !            write (iout,*) "backbone ",atom
3587 #ifdef DEBUG
3588             write (iout,'(2i3,2x,a,3f8.3)') &
3589             ires,itype(ires,1),res,(c(j,ires),j=1,3)
3590 #endif
3591             iii=iii+1
3592               nres_molec(molecule)=nres_molec(molecule)+1
3593             do j=1,3
3594               sccor(j,iii)=c(j,ires)
3595             enddo
3596           else if (.not.unres_pdb .and. (atom.eq."C1'" .or. &
3597                atom.eq."C2'" .or. atom.eq."C3'" &
3598                .or. atom.eq."C4'" .or. atom.eq."O4'")) then
3599             read(card(31:54),'(3f8.3)') (ccc(j),j=1,3)
3600 !c            write (2,'(i5,3f10.5)') ires,(ccc(j),j=1,3)
3601 !              print *,ires,ishift,ishift1
3602             counter=counter+1
3603 !            iii=iii+1
3604 !            do j=1,3
3605 !              sccor(j,iii)=c(j,ires)
3606 !            enddo
3607             do j=1,3
3608               c(j,ires)=c(j,ires)+ccc(j)/5.0
3609             enddo
3610              print *,counter,molecule
3611              if (counter.eq.5) then
3612 !            iii=iii+1
3613               nres_molec(molecule)=nres_molec(molecule)+1
3614               firstion=0
3615 !            do j=1,3
3616 !              sccor(j,iii)=c(j,ires)
3617 !            enddo
3618              counter=0
3619            endif
3620 !            print *, "ATOM",atom(1:3)
3621           else if (atom.eq."C5'") then
3622              read (card(19:19),'(a1)') sugar
3623              isugar=sugarcode(sugar,ires)
3624             if (ibeg.eq.1) then
3625               istype(1)=isugar
3626             else
3627               istype(ires)=isugar
3628 !              print *,ires,istype(ires)
3629             endif
3630             if (unres_pdb) then
3631               molecule=2
3632 !              print *,"nres_molec(molecule)",nres_molec(molecule),ires
3633               read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
3634               nres_molec(molecule)=nres_molec(molecule)+1
3635               print *,"nres_molec(molecule)",nres_molec(molecule),ires
3636
3637             else
3638               iii=iii+1
3639               read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
3640             endif
3641           else if ((atom.eq."C1'").and.unres_pdb) then
3642               iii=iii+1
3643               read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
3644 !            write (*,*) card(23:27),ires,itype(ires,1)
3645           else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. &
3646                    atom.ne.'N' .and. atom.ne.'C' .and. &
3647                    atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. &
3648                    atom.ne.'OXT' .and. atom(:2).ne.'3H' &
3649                    .and. atom.ne.'P  '.and. &
3650                   atom(1:1).ne.'H' .and. &
3651                   atom.ne.'OP1' .and. atom.ne.'OP2 '.and. atom.ne.'OP3'&
3652                   ) then
3653 !            write (iout,*) "sidechain ",atom
3654 !            write (iout,*) "sidechain ",atom,molecule,ires,atom(3:3)
3655                  if ((molecule.ne.2).or.(atom(3:3).ne."'")) then
3656 !                        write (iout,*) "sidechain ",atom,molecule,ires,atom(3:3)
3657             iii=iii+1
3658             read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
3659               endif
3660           endif
3661 !         print *,"IONS",ions,card(1:6)
3662         else if ((ions).and.(card(1:6).eq.'HETATM')) then
3663        if (firstion.eq.0) then
3664        firstion=1
3665        if (unres_pdb) then
3666          do j=1,3
3667            dc(j,ires)=sccor(j,iii)
3668          enddo
3669        else
3670           call sccenter(ires,iii,sccor)
3671        endif ! unres_pdb
3672        endif !firstion
3673           read (card(12:16),*) atom
3674 !          print *,"HETATOM", atom
3675           read (card(18:20),'(a3)') res
3676           if ((atom(1:2).eq.'NA').or.(atom(1:2).eq.'CL').or.&
3677           (atom(1:2).eq.'CA').or.(atom(1:2).eq.'MG')           &
3678           .or.(atom(1:2).eq.'K ')) &
3679           then
3680            ires=ires+1
3681            if (molecule.ne.5) molecprev=molecule
3682            molecule=5
3683            nres_molec(molecule)=nres_molec(molecule)+1
3684            print *,"HERE",nres_molec(molecule)
3685            res=res(2:3)//' '
3686            itype(ires,molecule)=rescode(ires,res,0,molecule)
3687            read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
3688           endif! NA
3689         endif !atom
3690       enddo
3691    10 write (iout,'(a,i5)') ' Number of residues found: ',ires
3692       if (ires.eq.0) return
3693 ! Calculate dummy residue coordinates inside the "chain" of a multichain
3694 ! system
3695       nres=ires
3696       if (((ires_old.ne.ires).and.(molecule.ne.5)) &
3697         ) &
3698          nres_molec(molecule)=nres_molec(molecule)-2
3699       print *,'I have',nres, nres_molec(:)
3700
3701       do k=1,4 ! ions are without dummy
3702        if (nres_molec(k).eq.0) cycle
3703       do i=2,nres-1
3704 !        write (iout,*) i,itype(i,1)
3705 !        if (itype(i,1).eq.ntyp1) then
3706 !          write (iout,*) "dummy",i,itype(i,1)
3707 !          do j=1,3
3708 !            c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2
3709 !            c(j,i)=(c(j,i-1)+c(j,i+1))/2
3710 !            dc(j,i)=c(j,i)
3711 !          enddo
3712 !        endif
3713         if (itype(i,k).eq.ntyp1_molec(k)) then
3714          if (itype(i+1,k).eq.ntyp1_molec(k)) then
3715           if (itype(i+2,k).eq.0) then
3716 !           print *,"masz sieczke"
3717            do j=1,5
3718             if (itype(i+2,j).ne.0) then
3719             itype(i+1,k)=0
3720             itype(i+1,j)=ntyp1_molec(j)
3721             nres_molec(k)=nres_molec(k)-1
3722             nres_molec(j)=nres_molec(j)+1
3723             go to 3331
3724             endif
3725            enddo
3726  3331      continue
3727           endif
3728 ! 16/01/2014 by Adasko: Adding to dummy atoms in the chain
3729 ! first is connected prevous chain (itype(i+1,1).eq.ntyp1)=true
3730 ! second dummy atom is conected to next chain itype(i+1,1).eq.ntyp1=false
3731 !           if (unres_pdb) then
3732 ! 2/15/2013 by Adam: corrected insertion of the last dummy residue
3733 !            print *,i,'tu dochodze'
3734 !            call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
3735 !            if (fail) then
3736 !              e2(1)=0.0d0
3737 !              e2(2)=1.0d0
3738 !              e2(3)=0.0d0
3739 !            endif !fail
3740 !            print *,i,'a tu?'
3741 !            do j=1,3
3742 !             c(j,i)=c(j,i-1)-1.9d0*e2(j)
3743 !            enddo
3744 !           else   !unres_pdb
3745            do j=1,3
3746              dcj=(c(j,i-2)-c(j,i-3))/2.0
3747             if (dcj.eq.0) dcj=1.23591524223
3748              c(j,i)=c(j,i-1)+dcj
3749              c(j,nres+i)=c(j,i)
3750            enddo
3751 !          endif   !unres_pdb
3752          else     !itype(i+1,1).eq.ntyp1
3753 !          if (unres_pdb) then
3754 ! 2/15/2013 by Adam: corrected insertion of the first dummy residue
3755 !            call refsys(i+1,i+2,i+3,e1,e2,e3,fail)
3756 !            if (fail) then
3757 !              e2(1)=0.0d0
3758 !              e2(2)=1.0d0
3759 !              e2(3)=0.0d0
3760 !            endif
3761             do j=1,3
3762 !              c(j,i)=c(j,i+1)-1.9d0*e2(j)
3763              c(j,i)=c(j,i-1)+1.9d0*(-e1(j)+e2(j))/sqrt(2.0d0)
3764             enddo
3765 !          else !unres_pdb
3766            do j=1,3
3767             dcj=(c(j,i+3)-c(j,i+2))/2.0
3768             if (dcj.eq.0) dcj=1.23591524223
3769             c(j,i)=c(j,i+1)-dcj
3770             c(j,nres+i)=c(j,i)
3771            enddo
3772 !          endif !unres_pdb
3773          endif !itype(i+1,1).eq.ntyp1
3774         endif  !itype.eq.ntyp1
3775
3776       enddo
3777       enddo
3778 ! Calculate the CM of the last side chain.
3779       if (iii.gt.0)  then
3780       if (unres_pdb) then
3781         do j=1,3
3782           dc(j,ires)=sccor(j,iii)
3783         enddo
3784       else
3785         call sccenter(ires,iii,sccor)
3786       endif
3787       endif
3788 !      nres=ires
3789       nsup=nres
3790       nstart_sup=1
3791 !      print *,"molecule",molecule
3792       if ((itype(nres,1).ne.10)) then
3793         nres=nres+1
3794           if (molecule.eq.5) molecule=molecprev
3795         itype(nres,molecule)=ntyp1_molec(molecule)
3796         nres_molec(molecule)=nres_molec(molecule)+1
3797 !        if (unres_pdb) then
3798 ! 2/15/2013 by Adam: corrected insertion of the last dummy residue
3799 !          call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
3800 !          if (fail) then
3801 !            e2(1)=0.0d0
3802 !            e2(2)=1.0d0
3803 !            e2(3)=0.0d0
3804 !          endif
3805 !          do j=1,3
3806 !            c(j,nres)=c(j,nres-1)-1.9d0*e2(j)
3807 !          enddo
3808 !        else
3809         do j=1,3
3810           dcj=(c(j,nres-2)-c(j,nres-3))/2.0
3811           c(j,nres)=c(j,nres-1)+dcj
3812           c(j,2*nres)=c(j,nres)
3813         enddo
3814 !        endif
3815       endif
3816 !     print *,'I have',nres, nres_molec(:)
3817
3818 !el kontrola nres w pliku inputowym WHAM-a w porownaniu z wartoscia wczytana z pliku pdb
3819 #ifdef WHAM_RUN
3820       if (nres.ne.nres0) then
3821         write (iout,*) "Error: wrong parameter value: NRES=",nres,&
3822                        " NRES0=",nres0
3823         stop "Error nres value in WHAM input"
3824       endif
3825 #endif
3826 !---------------------------------
3827 !el reallocate tables
3828 !      do i=1,maxres/3
3829 !       do j=1,2
3830 !         hfrag_alloc(j,i)=hfrag(j,i)
3831 !        enddo
3832 !       do j=1,4
3833 !         bfrag_alloc(j,i)=bfrag(j,i)
3834 !        enddo
3835 !      enddo
3836
3837 !      deallocate(hfrag)
3838 !      deallocate(bfrag)
3839 !      allocate(hfrag(2,nres/3)) !(2,maxres/3)
3840 !el      allocate(hfrag(2,nhfrag)) !(2,maxres/3)
3841 !el      allocate(bfrag(4,nbfrag)) !(4,maxres/3)
3842 !      allocate(bfrag(4,nres/3)) !(4,maxres/3)
3843
3844 !      do i=1,nhfrag
3845 !       do j=1,2
3846 !         hfrag(j,i)=hfrag_alloc(j,i)
3847 !        enddo
3848 !      enddo
3849 !      do i=1,nbfrag
3850 !       do j=1,4
3851 !         bfrag(j,i)=bfrag_alloc(j,i)
3852 !        enddo
3853 !      enddo
3854 !el end reallocate tables
3855 !---------------------------------
3856       do i=2,nres-1
3857         do j=1,3
3858           c(j,i+nres)=dc(j,i)
3859         enddo
3860       enddo
3861       do j=1,3
3862         c(j,nres+1)=c(j,1)
3863         c(j,2*nres)=c(j,nres)
3864       enddo
3865
3866       if (itype(1,1).eq.ntyp1) then
3867         nsup=nsup-1
3868         nstart_sup=2
3869         if (unres_pdb) then
3870 ! 2/15/2013 by Adam: corrected insertion of the first dummy residue
3871           call refsys(2,3,4,e1,e2,e3,fail)
3872           if (fail) then
3873             e2(1)=0.0d0
3874             e2(2)=1.0d0
3875             e2(3)=0.0d0
3876           endif
3877           do j=1,3
3878 !            c(j,1)=c(j,2)-1.9d0*e2(j)
3879              c(j,1)=c(j,2)+1.9d0*(e1(j)-e2(j))/sqrt(2.0d0)
3880           enddo
3881         else
3882         do j=1,3
3883           dcj=(c(j,4)-c(j,3))/2.0
3884           c(j,1)=c(j,2)-dcj
3885           c(j,nres+1)=c(j,1)
3886         enddo
3887         endif
3888       endif
3889 ! First lets assign correct dummy to correct type of chain
3890 ! 1) First residue
3891       if (itype(1,1).eq.ntyp1) then
3892         if (itype(2,1).eq.0) then
3893          do j=2,5
3894            if (itype(2,j).ne.0) then
3895            itype(1,1)=0
3896            itype(1,j)=ntyp1_molec(j)
3897            nres_molec(1)=nres_molec(1)-1
3898            nres_molec(j)=nres_molec(j)+1
3899            go to 3231
3900            endif
3901          enddo
3902 3231    continue
3903         endif
3904        endif
3905        print *,'I have',nres, nres_molec(:)
3906
3907 ! Copy the coordinates to reference coordinates
3908 !      do i=1,2*nres
3909 !        do j=1,3
3910 !          cref(j,i)=c(j,i)
3911 !        enddo
3912 !      enddo
3913 ! Calculate internal coordinates.
3914       if (lprn) then
3915       write (iout,'(/a)') &
3916         "Cartesian coordinates of the reference structure"
3917       write (iout,'(a,16x,3(3x,a5),5x,3(3x,a5))') &
3918        "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
3919       do ires=1,nres
3920         write (iout,'(5(a3,1x),i5,3f8.3,5x,3f8.3)') &
3921           (restyp(itype(ires,j),j),j=1,5),ires,(c(j,ires),j=1,3),&
3922           (c(j,ires+nres),j=1,3)
3923       enddo
3924       endif
3925 ! znamy już nres wiec mozna alokowac tablice
3926 ! Calculate internal coordinates.
3927       if(me.eq.king.or..not.out1file)then
3928        write (iout,'(a)') &
3929          "Backbone and SC coordinates as read from the PDB"
3930        do ires=1,nres
3931         write (iout,'(i5,i3,2x,a,3f8.3,5x,3f8.3)') &
3932           ires,itype(ires,1),restyp(itype(ires,1),1),(c(j,ires),j=1,3),&
3933           (c(j,nres+ires),j=1,3)
3934        enddo
3935       endif
3936 ! NOW LETS ROCK! SORTING
3937       allocate(c_temporary(3,2*nres))
3938       allocate(itype_temporary(nres,5))
3939       if (.not.allocated(molnum)) allocate(molnum(nres+1))
3940       if (.not.allocated(istype)) write(iout,*) &
3941           "SOMETHING WRONG WITH ISTYTPE"
3942       allocate(istype_temp(nres))
3943        itype_temporary(:,:)=0
3944       seqalingbegin=1
3945       do k=1,5
3946         do i=1,nres
3947          if (itype(i,k).ne.0) then
3948           do j=1,3
3949           c_temporary(j,seqalingbegin)=c(j,i)
3950           c_temporary(j,seqalingbegin+nres)=c(j,i+nres)
3951
3952           enddo
3953           itype_temporary(seqalingbegin,k)=itype(i,k)
3954           print *,i,k,itype(i,k),itype_temporary(seqalingbegin,k),seqalingbegin
3955           istype_temp(seqalingbegin)=istype(i)
3956           molnum(seqalingbegin)=k
3957           seqalingbegin=seqalingbegin+1
3958          endif
3959         enddo
3960        enddo
3961        do i=1,2*nres
3962         do j=1,3
3963         c(j,i)=c_temporary(j,i)
3964         enddo
3965        enddo
3966        do k=1,5
3967         do i=1,nres
3968          itype(i,k)=itype_temporary(i,k)
3969          istype(i)=istype_temp(i)
3970         enddo
3971        enddo
3972 !      if (itype(1,1).eq.ntyp1) then
3973 !        nsup=nsup-1
3974 !        nstart_sup=2
3975 !        if (unres_pdb) then
3976 ! 2/15/2013 by Adam: corrected insertion of the first dummy residue
3977 !          call refsys(2,3,4,e1,e2,e3,fail)
3978 !          if (fail) then
3979 !            e2(1)=0.0d0
3980 !            e2(2)=1.0d0
3981 !            e2(3)=0.0d0
3982 !          endif
3983 !          do j=1,3
3984 !            c(j,1)=c(j,2)-1.9d0*e2(j)
3985 !          enddo
3986 !        else
3987 !        do j=1,3
3988 !          dcj=(c(j,4)-c(j,3))/2.0
3989 !          c(j,1)=c(j,2)-dcj
3990 !          c(j,nres+1)=c(j,1)
3991 !        enddo
3992 !        endif
3993 !      endif
3994
3995       if (lprn) then
3996       write (iout,'(/a)') &
3997         "Cartesian coordinates of the reference structure after sorting"
3998       write (iout,'(a,16x,3(3x,a5),5x,3(3x,a5))') &
3999        "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
4000       do ires=1,nres
4001         write (iout,'(5(a3,1x),i5,3f8.3,5x,3f8.3)') &
4002           (restyp(itype(ires,j),j),j=1,5),ires,(c(j,ires),j=1,3),&
4003           (c(j,ires+nres),j=1,3)
4004       enddo
4005       endif
4006
4007 !       print *,seqalingbegin,nres
4008       if(.not.allocated(vbld)) then
4009        allocate(vbld(2*nres))
4010        do i=1,2*nres
4011          vbld(i)=0.d0
4012        enddo
4013       endif
4014       if(.not.allocated(vbld_inv)) then
4015        allocate(vbld_inv(2*nres))
4016        do i=1,2*nres
4017          vbld_inv(i)=0.d0
4018        enddo
4019       endif
4020 !!!el
4021       if(.not.allocated(theta)) then
4022         allocate(theta(nres+2))
4023         theta(:)=0.0d0
4024       endif
4025
4026       if(.not.allocated(phi)) allocate(phi(nres+2))
4027       if(.not.allocated(alph)) allocate(alph(nres+2))
4028       if(.not.allocated(omeg)) allocate(omeg(nres+2))
4029       if(.not.allocated(thetaref)) allocate(thetaref(nres+2))
4030       if(.not.allocated(phiref)) allocate(phiref(nres+2))
4031       if(.not.allocated(costtab)) allocate(costtab(nres))
4032       if(.not.allocated(sinttab)) allocate(sinttab(nres))
4033       if(.not.allocated(cost2tab)) allocate(cost2tab(nres))
4034       if(.not.allocated(sint2tab)) allocate(sint2tab(nres))
4035       if(.not.allocated(xxref)) allocate(xxref(nres))
4036       if(.not.allocated(yyref)) allocate(yyref(nres))
4037       if(.not.allocated(zzref)) allocate(zzref(nres)) !(maxres)
4038       if(.not.allocated(dc_norm)) then
4039 !      if(.not.allocated(dc_norm)) allocate(dc_norm(3,0:2*nres+2))
4040         allocate(dc_norm(3,0:2*nres+2))
4041         dc_norm(:,:)=0.d0
4042       endif
4043
4044       call int_from_cart(.true.,.false.)
4045       call sc_loc_geom(.false.)
4046       do i=1,nres
4047         thetaref(i)=theta(i)
4048         phiref(i)=phi(i)
4049       enddo
4050 !      do i=1,2*nres
4051 !        vbld_inv(i)=0.d0
4052 !        vbld(i)=0.d0
4053 !      enddo
4054
4055       do i=1,nres-1
4056         do j=1,3
4057           dc(j,i)=c(j,i+1)-c(j,i)
4058           dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
4059         enddo
4060       enddo
4061       do i=2,nres-1
4062         do j=1,3
4063           dc(j,i+nres)=c(j,i+nres)-c(j,i)
4064           dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
4065         enddo
4066 !      write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),&
4067 !        vbld_inv(i+nres)
4068       enddo
4069 !      call chainbuild
4070 ! Copy the coordinates to reference coordinates
4071 ! Splits to single chain if occurs
4072
4073 !      do i=1,2*nres
4074 !        do j=1,3
4075 !          cref(j,i,cou)=c(j,i)
4076 !        enddo
4077 !      enddo
4078 !
4079       if(.not.allocated(cref)) allocate(cref(3,2*nres+2,maxperm)) !(3,maxres2+2,maxperm)
4080       if(.not.allocated(chain_rep)) allocate(chain_rep(3,2*nres+2,maxsym)) !(3,maxres2+2,maxsym)
4081       if(.not.allocated(tabperm)) allocate(tabperm(maxperm,maxsym)) !(maxperm,maxsym)
4082 !-----------------------------
4083       kkk=1
4084       lll=0
4085       cou=1
4086         write (iout,*) "symetr", symetr
4087       do i=1,nres
4088       lll=lll+1
4089 !      write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
4090       if (i.gt.1) then
4091       if ((itype(i-1,1).eq.ntyp1).and.(i.gt.2)) then
4092       chain_length=lll-1
4093       kkk=kkk+1
4094 !       write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
4095       lll=1
4096       endif
4097       endif
4098         do j=1,3
4099           cref(j,i,cou)=c(j,i)
4100           cref(j,i+nres,cou)=c(j,i+nres)
4101           if (i.le.nres) then
4102           chain_rep(j,lll,kkk)=c(j,i)
4103           chain_rep(j,lll+nres,kkk)=c(j,i+nres)
4104           endif
4105          enddo
4106       enddo
4107       write (iout,*) chain_length
4108       if (chain_length.eq.0) chain_length=nres
4109       do j=1,3
4110       chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
4111       chain_rep(j,chain_length+nres,symetr) &
4112       =chain_rep(j,chain_length+nres,1)
4113       enddo
4114 ! diagnostic
4115 !       write (iout,*) "spraw lancuchy",chain_length,symetr
4116 !       do i=1,4
4117 !         do kkk=1,chain_length
4118 !           write (iout,*) itype(kkk,1),(chain_rep(j,kkk,i), j=1,3)
4119 !         enddo
4120 !        enddo
4121 ! enddiagnostic
4122 ! makes copy of chains
4123         write (iout,*) "symetr", symetr
4124       do j=1,3
4125       dc(j,0)=c(j,1)
4126       enddo
4127
4128       if (symetr.gt.1) then
4129        call permut(symetr)
4130        nperm=1
4131        do i=1,symetr
4132        nperm=nperm*i
4133        enddo
4134        do i=1,nperm
4135        write(iout,*) (tabperm(i,kkk),kkk=1,4)
4136        enddo
4137        do i=1,nperm
4138         cou=0
4139         do kkk=1,symetr
4140          icha=tabperm(i,kkk)
4141          write (iout,*) i,icha
4142          do lll=1,chain_length
4143           cou=cou+1
4144            if (cou.le.nres) then
4145            do j=1,3
4146             kupa=mod(lll,chain_length)
4147             iprzes=(kkk-1)*chain_length+lll
4148             if (kupa.eq.0) kupa=chain_length
4149             write (iout,*) "kupa", kupa
4150             cref(j,iprzes,i)=chain_rep(j,kupa,icha)
4151             cref(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha)
4152           enddo
4153           endif
4154          enddo
4155         enddo
4156        enddo
4157        endif
4158 !-koniec robienia kopii
4159 ! diag
4160       do kkk=1,nperm
4161       write (iout,*) "nowa struktura", nperm
4162       do i=1,nres
4163         write (iout,110) restyp(itype(i,1),1),i,cref(1,i,kkk),&
4164       cref(2,i,kkk),&
4165       cref(3,i,kkk),cref(1,nres+i,kkk),&
4166       cref(2,nres+i,kkk),cref(3,nres+i,kkk)
4167       enddo
4168   100 format (//'                alpha-carbon coordinates       ',&
4169                 '     centroid coordinates'/ &
4170                 '       ', 6X,'X',11X,'Y',11X,'Z', &
4171                                 10X,'X',11X,'Y',11X,'Z')
4172   110 format (a,'(',i5,')',6f12.5)
4173
4174       enddo
4175 !c enddiag
4176       do j=1,nbfrag
4177         do i=1,4
4178          bfrag(i,j)=bfrag(i,j)-ishift
4179         enddo
4180       enddo
4181
4182       do j=1,nhfrag
4183         do i=1,2
4184          hfrag(i,j)=hfrag(i,j)-ishift
4185         enddo
4186       enddo
4187       ishift_pdb=ishift
4188
4189       return
4190       end subroutine readpdb
4191 #if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
4192 !-----------------------------------------------------------------------------
4193 ! readrtns_CSA.F
4194 !-----------------------------------------------------------------------------
4195       subroutine read_control
4196 !
4197 ! Read contorl data
4198 !
4199 !      use geometry_data
4200       use comm_machsw
4201       use energy_data
4202       use control_data
4203       use compare_data
4204       use MCM_data
4205       use map_data
4206       use csa_data
4207       use MD_data
4208       use MPI_data
4209       use random, only: random_init
4210 !      implicit real*8 (a-h,o-z)
4211 !      include 'DIMENSIONS'
4212 #ifdef MP
4213       use prng, only:prng_restart
4214       include 'mpif.h'
4215       logical :: OKRandom!, prng_restart
4216       real(kind=8) :: r1
4217 #endif
4218 !      include 'COMMON.IOUNITS'
4219 !      include 'COMMON.TIME1'
4220 !      include 'COMMON.THREAD'
4221 !      include 'COMMON.SBRIDGE'
4222 !      include 'COMMON.CONTROL'
4223 !      include 'COMMON.MCM'
4224 !      include 'COMMON.MAP'
4225 !      include 'COMMON.HEADER'
4226 !      include 'COMMON.CSA'
4227 !      include 'COMMON.CHAIN'
4228 !      include 'COMMON.MUCA'
4229 !      include 'COMMON.MD'
4230 !      include 'COMMON.FFIELD'
4231 !      include 'COMMON.INTERACT'
4232 !      include 'COMMON.SETUP'
4233 !el      integer :: KDIAG,ICORFL,IXDR
4234 !el      COMMON /MACHSW/ KDIAG,ICORFL,IXDR
4235       character(len=8),dimension(0:3) :: diagmeth = reshape((/'Library ',&
4236         'EVVRSP  ','Givens  ','Jacobi  '/),shape(diagmeth))
4237 !      character(len=80) :: ucase
4238       character(len=640) :: controlcard
4239
4240       real(kind=8) :: seed,rmsdbc,rmsdbc1max,rmsdbcm,drms,timem!,&
4241       integer i
4242
4243       nglob_csa=0
4244       eglob_csa=1d99
4245       nmin_csa=0
4246       read (INP,'(a)') titel
4247       call card_concat(controlcard,.true.)
4248 !      out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0
4249 !      print *,"Processor",me," fg_rank",fg_rank," out1file",out1file
4250       call reada(controlcard,'SEED',seed,0.0D0)
4251       call random_init(seed)
4252 ! Set up the time limit (caution! The time must be input in minutes!)
4253       read_cart=index(controlcard,'READ_CART').gt.0
4254       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
4255       call readi(controlcard,'SYM',symetr,1)
4256       call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours
4257       unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
4258       call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes
4259       call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
4260       call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
4261       call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
4262       call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
4263       call reada(controlcard,'DRMS',drms,0.1D0)
4264       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4265        write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
4266        write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
4267        write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
4268        write (iout,'(a,f10.1)')'DRMS    = ',drms
4269        write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
4270        write (iout,'(a,f10.1)') 'Time limit (min):',timlim
4271       endif
4272       call readi(controlcard,'NZ_START',nz_start,0)
4273       call readi(controlcard,'NZ_END',nz_end,0)
4274       call readi(controlcard,'IZ_SC',iz_sc,0)
4275       timlim=60.0D0*timlim
4276       safety = 60.0d0*safety
4277       timem=timlim
4278       modecalc=0
4279       call reada(controlcard,"T_BATH",t_bath,300.0d0)
4280 !C SHIELD keyword sets if the shielding effect of side-chains is used
4281 !C 0 denots no shielding is used all peptide are equally despite the
4282 !C solvent accesible area
4283 !C 1 the newly introduced function
4284 !C 2 reseved for further possible developement
4285       call readi(controlcard,'SHIELD',shield_mode,0)
4286 !C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4287         write(iout,*) "shield_mode",shield_mode
4288       call readi(controlcard,'TORMODE',tor_mode,0)
4289 !C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4290         write(iout,*) "torsional and valence angle mode",tor_mode
4291
4292 !C  Varibles set size of box
4293       with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
4294       protein=index(controlcard,"PROTEIN").gt.0
4295       ions=index(controlcard,"IONS").gt.0
4296       nucleic=index(controlcard,"NUCLEIC").gt.0
4297       write (iout,*) "with_theta_constr ",with_theta_constr
4298       AFMlog=(index(controlcard,'AFM'))
4299       selfguide=(index(controlcard,'SELFGUIDE'))
4300       print *,'AFMlog',AFMlog,selfguide,"KUPA"
4301       call readi(controlcard,'GENCONSTR',genconstr,0)
4302       call reada(controlcard,'BOXX',boxxsize,100.0d0)
4303       call reada(controlcard,'BOXY',boxysize,100.0d0)
4304       call reada(controlcard,'BOXZ',boxzsize,100.0d0)
4305       call readi(controlcard,'TUBEMOD',tubemode,0)
4306       print *,"SCELE",scelemode
4307       call readi(controlcard,"SCELEMODE",scelemode,0)
4308       print *,"SCELE",scelemode
4309
4310 ! elemode = 0 is orignal UNRES electrostatics
4311 ! elemode = 1 is "Momo" potentials in progress
4312 ! elemode = 2 is in development EVALD
4313
4314
4315       write (iout,*) TUBEmode,"TUBEMODE"
4316       if (TUBEmode.gt.0) then
4317        call reada(controlcard,"XTUBE",tubecenter(1),0.0d0)
4318        call reada(controlcard,"YTUBE",tubecenter(2),0.0d0)
4319        call reada(controlcard,"ZTUBE",tubecenter(3),0.0d0)
4320        call reada(controlcard,"RTUBE",tubeR0,0.0d0)
4321        call reada(controlcard,"TUBETOP",bordtubetop,boxzsize)
4322        call reada(controlcard,"TUBEBOT",bordtubebot,0.0d0)
4323        call reada(controlcard,"TUBEBUF",tubebufthick,1.0d0)
4324        buftubebot=bordtubebot+tubebufthick
4325        buftubetop=bordtubetop-tubebufthick
4326       endif
4327
4328 ! CUTOFFF ON ELECTROSTATICS
4329       call reada(controlcard,"R_CUT_ELE",r_cut_ele,15.0d0)
4330       call reada(controlcard,"LAMBDA_ELE",rlamb_ele,0.3d0)
4331       write(iout,*) "R_CUT_ELE=",r_cut_ele
4332 ! Lipidic parameters
4333       call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
4334       call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
4335       if (lipthick.gt.0.0d0) then
4336        bordliptop=(boxzsize+lipthick)/2.0
4337        bordlipbot=bordliptop-lipthick
4338       if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0)) &
4339       write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
4340       buflipbot=bordlipbot+lipbufthick
4341       bufliptop=bordliptop-lipbufthick
4342       if ((lipbufthick*2.0d0).gt.lipthick) &
4343        write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
4344       endif !lipthick.gt.0
4345       write(iout,*) "bordliptop=",bordliptop
4346       write(iout,*) "bordlipbot=",bordlipbot
4347       write(iout,*) "bufliptop=",bufliptop
4348       write(iout,*) "buflipbot=",buflipbot
4349       write (iout,*) "SHIELD MODE",shield_mode
4350
4351 !C-------------------------
4352       minim=(index(controlcard,'MINIMIZE').gt.0)
4353       dccart=(index(controlcard,'CART').gt.0)
4354       overlapsc=(index(controlcard,'OVERLAP').gt.0)
4355       overlapsc=.not.overlapsc
4356       searchsc=(index(controlcard,'NOSEARCHSC').gt.0)
4357       searchsc=.not.searchsc
4358       sideadd=(index(controlcard,'SIDEADD').gt.0)
4359       energy_dec=(index(controlcard,'ENERGY_DEC').gt.0)
4360       outpdb=(index(controlcard,'PDBOUT').gt.0)
4361       outmol2=(index(controlcard,'MOL2OUT').gt.0)
4362       pdbref=(index(controlcard,'PDBREF').gt.0)
4363       refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
4364       indpdb=index(controlcard,'PDBSTART')
4365       extconf=(index(controlcard,'EXTCONF').gt.0)
4366       call readi(controlcard,'IPRINT',iprint,0)
4367       call readi(controlcard,'MAXGEN',maxgen,10000)
4368       call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
4369       call readi(controlcard,"KDIAG",kdiag,0)
4370       call readi(controlcard,"RESCALE_MODE",rescale_mode,2)
4371       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) &
4372        write (iout,*) "RESCALE_MODE",rescale_mode
4373       split_ene=index(controlcard,'SPLIT_ENE').gt.0
4374       if (index(controlcard,'REGULAR').gt.0.0D0) then
4375         call reada(controlcard,'WEIDIS',weidis,0.1D0)
4376         modecalc=1
4377         refstr=.true.
4378       endif
4379       if (index(controlcard,'CHECKGRAD').gt.0) then
4380         modecalc=5
4381         if (index(controlcard,'CART').gt.0) then
4382           icheckgrad=1
4383         elseif (index(controlcard,'CARINT').gt.0) then
4384           icheckgrad=2
4385         else
4386           icheckgrad=3
4387         endif
4388       elseif (index(controlcard,'THREAD').gt.0) then
4389         modecalc=2
4390         call readi(controlcard,'THREAD',nthread,0)
4391         if (nthread.gt.0) then
4392           call reada(controlcard,'WEIDIS',weidis,0.1D0)
4393         else
4394           if (fg_rank.eq.0) &
4395           write (iout,'(a)')'A number has to follow the THREAD keyword.'
4396           stop 'Error termination in Read_Control.'
4397         endif
4398       else if (index(controlcard,'MCMA').gt.0) then
4399         modecalc=3
4400       else if (index(controlcard,'MCEE').gt.0) then
4401         modecalc=6
4402       else if (index(controlcard,'MULTCONF').gt.0) then
4403         modecalc=4
4404       else if (index(controlcard,'MAP').gt.0) then
4405         modecalc=7
4406         call readi(controlcard,'MAP',nmap,0)
4407       else if (index(controlcard,'CSA').gt.0) then
4408         modecalc=8
4409 !rc      else if (index(controlcard,'ZSCORE').gt.0) then
4410 !rc
4411 !rc  ZSCORE is rm from UNRES, modecalc=9 is available
4412 !rc
4413 !rc        modecalc=9
4414 !fcm      else if (index(controlcard,'MCMF').gt.0) then
4415 !fmc        modecalc=10
4416       else if (index(controlcard,'SOFTREG').gt.0) then
4417         modecalc=11
4418       else if (index(controlcard,'CHECK_BOND').gt.0) then
4419         modecalc=-1
4420       else if (index(controlcard,'TEST').gt.0) then
4421         modecalc=-2
4422       else if (index(controlcard,'MD').gt.0) then
4423         modecalc=12
4424       else if (index(controlcard,'RE ').gt.0) then
4425         modecalc=14
4426       endif
4427
4428       lmuca=index(controlcard,'MUCA').gt.0
4429       call readi(controlcard,'MUCADYN',mucadyn,0)
4430       call readi(controlcard,'MUCASMOOTH',muca_smooth,0)
4431       if (lmuca .and. (me.eq.king .or. .not.out1file )) &
4432        then
4433        write (iout,*) 'MUCADYN=',mucadyn
4434        write (iout,*) 'MUCASMOOTH=',muca_smooth
4435       endif
4436
4437       iscode=index(controlcard,'ONE_LETTER')
4438       indphi=index(controlcard,'PHI')
4439       indback=index(controlcard,'BACK')
4440       iranconf=index(controlcard,'RAND_CONF')
4441       i2ndstr=index(controlcard,'USE_SEC_PRED')
4442       gradout=index(controlcard,'GRADOUT').gt.0
4443       gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
4444       call reada(controlcard,'DISTCHAINMAX',distchainmax,5.0d0)
4445       if (me.eq.king .or. .not.out1file ) &
4446         write (iout,*) "DISTCHAINMAX",distchainmax
4447
4448       if(me.eq.king.or..not.out1file) &
4449        write (iout,'(2a)') diagmeth(kdiag),&
4450         ' routine used to diagonalize matrices.'
4451       if (shield_mode.gt.0) then
4452        pi=4.0D0*datan(1.0D0)
4453 !C VSolvSphere the volume of solving sphere
4454       print *,pi,"pi"
4455 !C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
4456 !C there will be no distinction between proline peptide group and normal peptide
4457 !C group in case of shielding parameters
4458       VSolvSphere=4.0/3.0*pi*(4.50d0)**3
4459       VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(4.50/2.0)**3
4460       write (iout,*) VSolvSphere,VSolvSphere_div
4461 !C long axis of side chain
4462 !      do i=1,ntyp
4463 !      long_r_sidechain(i)=vbldsc0(1,i)
4464 !      short_r_sidechain(i)=sigma0(i)
4465 !      write(iout,*) "parame for long and short axis",i,vbldsc0(1,i),&
4466 !         sigma0(i)
4467 !      enddo
4468       buff_shield=1.0d0
4469       endif
4470       return
4471       end subroutine read_control
4472 !-----------------------------------------------------------------------------
4473       subroutine read_REMDpar
4474 !
4475 ! Read REMD settings
4476 !
4477 !       use control
4478 !       use energy
4479 !       use geometry
4480       use REMD_data
4481       use MPI_data
4482       use control_data, only:out1file
4483 !      implicit real*8 (a-h,o-z)
4484 !      include 'DIMENSIONS'
4485 !      include 'COMMON.IOUNITS'
4486 !      include 'COMMON.TIME1'
4487 !      include 'COMMON.MD'
4488       use MD_data
4489 !el #ifndef LANG0
4490 !el      include 'COMMON.LANGEVIN'
4491 !el #else
4492 !el      include 'COMMON.LANGEVIN.lang0'
4493 !el #endif
4494 !      include 'COMMON.INTERACT'
4495 !      include 'COMMON.NAMES'
4496 !      include 'COMMON.GEO'
4497 !      include 'COMMON.REMD'
4498 !      include 'COMMON.CONTROL'
4499 !      include 'COMMON.SETUP'
4500 !      character(len=80) :: ucase
4501       character(len=320) :: controlcard
4502       character(len=3200) :: controlcard1
4503       integer :: iremd_m_total
4504 !el local variables
4505       integer :: i
4506 !     real(kind=8) :: var,ene
4507
4508       if(me.eq.king.or..not.out1file) &
4509        write (iout,*) "REMD setup"
4510
4511       call card_concat(controlcard,.true.)
4512       call readi(controlcard,"NREP",nrep,3)
4513       call readi(controlcard,"NSTEX",nstex,1000)
4514       call reada(controlcard,"RETMIN",retmin,10.0d0)
4515       call reada(controlcard,"RETMAX",retmax,1000.0d0)
4516       mremdsync=(index(controlcard,'SYNC').gt.0)
4517       call readi(controlcard,"NSYN",i_sync_step,100)
4518       restart1file=(index(controlcard,'REST1FILE').gt.0)
4519       traj1file=(index(controlcard,'TRAJ1FILE').gt.0)
4520       call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1)
4521       if(max_cache_traj_use.gt.max_cache_traj) &
4522                 max_cache_traj_use=max_cache_traj
4523       if(me.eq.king.or..not.out1file) then
4524 !d       if (traj1file) then
4525 !rc caching is in testing - NTWX is not ignored
4526 !d        write (iout,*) "NTWX value is ignored"
4527 !d        write (iout,*) "  trajectory is stored to one file by master"
4528 !d        write (iout,*) "  before exchange at NSTEX intervals"
4529 !d       endif
4530        write (iout,*) "NREP= ",nrep
4531        write (iout,*) "NSTEX= ",nstex
4532        write (iout,*) "SYNC= ",mremdsync
4533        write (iout,*) "NSYN= ",i_sync_step
4534        write (iout,*) "TRAJCACHE= ",max_cache_traj_use
4535       endif
4536       remd_tlist=.false.
4537       allocate(remd_t(nrep),remd_m(nrep)) !(maxprocs)
4538       if (index(controlcard,'TLIST').gt.0) then
4539          remd_tlist=.true.
4540          call card_concat(controlcard1,.true.)
4541          read(controlcard1,*) (remd_t(i),i=1,nrep)
4542          if(me.eq.king.or..not.out1file) &
4543           write (iout,*)'tlist',(remd_t(i),i=1,nrep)
4544       endif
4545       remd_mlist=.false.
4546       if (index(controlcard,'MLIST').gt.0) then
4547          remd_mlist=.true.
4548          call card_concat(controlcard1,.true.)
4549          read(controlcard1,*) (remd_m(i),i=1,nrep)
4550          if(me.eq.king.or..not.out1file) then
4551           write (iout,*)'mlist',(remd_m(i),i=1,nrep)
4552           iremd_m_total=0
4553           do i=1,nrep
4554            iremd_m_total=iremd_m_total+remd_m(i)
4555           enddo
4556           write (iout,*) 'Total number of replicas ',iremd_m_total
4557          endif
4558       endif
4559       if(me.eq.king.or..not.out1file) &
4560        write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
4561       return
4562       end subroutine read_REMDpar
4563 !-----------------------------------------------------------------------------
4564       subroutine read_MDpar
4565 !
4566 ! Read MD settings
4567 !
4568       use control_data, only: r_cut,rlamb,out1file
4569       use energy_data
4570       use geometry_data, only: pi
4571       use MPI_data
4572 !      implicit real*8 (a-h,o-z)
4573 !      include 'DIMENSIONS'
4574 !      include 'COMMON.IOUNITS'
4575 !      include 'COMMON.TIME1'
4576 !      include 'COMMON.MD'
4577       use MD_data
4578 !el #ifndef LANG0
4579 !el      include 'COMMON.LANGEVIN'
4580 !el #else
4581 !el      include 'COMMON.LANGEVIN.lang0'
4582 !el #endif
4583 !      include 'COMMON.INTERACT'
4584 !      include 'COMMON.NAMES'
4585 !      include 'COMMON.GEO'
4586 !      include 'COMMON.SETUP'
4587 !      include 'COMMON.CONTROL'
4588 !      include 'COMMON.SPLITELE'
4589 !      character(len=80) :: ucase
4590       character(len=320) :: controlcard
4591 !el local variables
4592       integer :: i,j
4593       real(kind=8) :: eta
4594
4595       call card_concat(controlcard,.true.)
4596       call readi(controlcard,"NSTEP",n_timestep,1000000)
4597       call readi(controlcard,"NTWE",ntwe,100)
4598       call readi(controlcard,"NTWX",ntwx,1000)
4599       call reada(controlcard,"DT",d_time,1.0d-1)
4600       call reada(controlcard,"DVMAX",dvmax,2.0d1)
4601       call reada(controlcard,"DAMAX",damax,1.0d1)
4602       call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1)
4603       call readi(controlcard,"LANG",lang,0)
4604       RESPA = index(controlcard,"RESPA") .gt. 0
4605       call readi(controlcard,"NTIME_SPLIT",ntime_split,1)
4606       ntime_split0=ntime_split
4607       call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64)
4608       ntime_split0=ntime_split
4609       call reada(controlcard,"R_CUT",r_cut,2.0d0)
4610       call reada(controlcard,"LAMBDA",rlamb,0.3d0)
4611       rest = index(controlcard,"REST").gt.0
4612       tbf = index(controlcard,"TBF").gt.0
4613       usampl = index(controlcard,"USAMPL").gt.0
4614       mdpdb = index(controlcard,"MDPDB").gt.0
4615       call reada(controlcard,"T_BATH",t_bath,300.0d0)
4616       call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1)
4617       call reada(controlcard,"EQ_TIME",eq_time,1.0d+4)
4618       call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000)
4619       if (count_reset_moment.eq.0) count_reset_moment=1000000000
4620       call readi(controlcard,"RESET_VEL",count_reset_vel,1000)
4621       reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0
4622       reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0
4623       if (count_reset_vel.eq.0) count_reset_vel=1000000000
4624       large = index(controlcard,"LARGE").gt.0
4625       print_compon = index(controlcard,"PRINT_COMPON").gt.0
4626       rattle = index(controlcard,"RATTLE").gt.0
4627       preminim=(index(controlcard,'PREMINIM').gt.0)
4628       write (iout,*) "PREMINIM ",preminim
4629       dccart=(index(controlcard,'CART').gt.0)
4630       if (preminim) call read_minim
4631 !  if performing umbrella sampling, fragments constrained are read from the fragment file
4632       nset=0
4633       if(usampl) then
4634         call read_fragments
4635       endif
4636
4637       if(me.eq.king.or..not.out1file) then
4638        write (iout,*)
4639        write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run "
4640        write (iout,*)
4641        write (iout,'(a)') "The units are:"
4642        write (iout,'(a)') "positions: angstrom, time: 48.9 fs"
4643        write (iout,'(2a)') "velocity: angstrom/(48.9 fs),",&
4644         " acceleration: angstrom/(48.9 fs)**2"
4645        write (iout,'(a)') "energy: kcal/mol, temperature: K"
4646        write (iout,*)
4647        write (iout,'(a60,i10)') "Number of time steps:",n_timestep
4648        write (iout,'(a60,f10.5,a)') &
4649         "Initial time step of numerical integration:",d_time,&
4650         " natural units"
4651        write (iout,'(60x,f10.5,a)') d_time*48.9," fs"
4652        if (RESPA) then
4653         write (iout,'(2a,i4,a)') &
4654           "A-MTS algorithm used; initial time step for fast-varying",&
4655           " short-range forces split into",ntime_split," steps."
4656         write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff",&
4657          r_cut," lambda",rlamb
4658        endif
4659        write (iout,'(2a,f10.5)') &
4660         "Maximum acceleration threshold to reduce the time step",&
4661         "/increase split number:",damax
4662        write (iout,'(2a,f10.5)') &
4663         "Maximum predicted energy drift to reduce the timestep",&
4664         "/increase split number:",edriftmax
4665        write (iout,'(a60,f10.5)') &
4666        "Maximum velocity threshold to reduce velocities:",dvmax
4667        write (iout,'(a60,i10)') "Frequency of property output:",ntwe
4668        write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx
4669        if (rattle) write (iout,'(a60)') &
4670         "Rattle algorithm used to constrain the virtual bonds"
4671       endif
4672       reset_fricmat=1000
4673       if (lang.gt.0) then
4674         call reada(controlcard,"ETAWAT",etawat,0.8904d0)
4675         call reada(controlcard,"RWAT",rwat,1.4d0)
4676         call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2)
4677         surfarea=index(controlcard,"SURFAREA").gt.0
4678         call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000)
4679         if(me.eq.king.or..not.out1file)then
4680          write (iout,'(/a,$)') "Langevin dynamics calculation"
4681          if (lang.eq.1) then
4682           write (iout,'(a/)') &
4683             " with direct integration of Langevin equations"
4684          else if (lang.eq.2) then
4685           write (iout,'(a/)') " with TINKER stochasic MD integrator"
4686          else if (lang.eq.3) then
4687           write (iout,'(a/)') " with Ciccotti's stochasic MD integrator"
4688          else if (lang.eq.4) then
4689           write (iout,'(a/)') " in overdamped mode"
4690          else
4691           write (iout,'(//a,i5)') &
4692             "=========== ERROR: Unknown Langevin dynamics mode:",lang
4693           stop
4694          endif
4695          write (iout,'(a60,f10.5)') "Temperature:",t_bath
4696          write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat
4697          write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat
4698          write (iout,'(a60,f10.5)') &
4699          "Scaling factor of the friction forces:",scal_fric
4700          if (surfarea) write (iout,'(2a,i10,a)') &
4701            "Friction coefficients will be scaled by solvent-accessible",&
4702            " surface area every",reset_fricmat," steps."
4703         endif
4704 ! Calculate friction coefficients and bounds of stochastic forces
4705         eta=6*pi*cPoise*etawat
4706         if(me.eq.king.or..not.out1file) &
4707          write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:",&
4708           eta
4709 !        allocate(gamp
4710         do j=1,5 !types of molecules
4711         gamp(j)=scal_fric*(pstok(j)+rwat)*eta
4712         stdfp(j)=dsqrt(2*Rb*t_bath/d_time)
4713         enddo
4714         allocate(gamsc(ntyp1,5),stdfsc(ntyp1,5)) !(ntyp1)
4715         do j=1,5 !types of molecules
4716         do i=1,ntyp
4717           gamsc(i,j)=scal_fric*(restok(i,j)+rwat)*eta
4718           stdfsc(i,j)=dsqrt(2*Rb*t_bath/d_time)
4719         enddo
4720         enddo
4721
4722         if(me.eq.king.or..not.out1file)then
4723          write (iout,'(/2a/)') &
4724          "Radii of site types and friction coefficients and std's of",&
4725          " stochastic forces of fully exposed sites"
4726          write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp(1),stdfp*dsqrt(gamp(1))
4727          do i=1,ntyp
4728           write (iout,'(a5,f5.2,2f10.5)') restyp(i,1),restok(i,1),&
4729            gamsc(i,1),stdfsc(i,1)*dsqrt(gamsc(i,1))
4730          enddo
4731         endif
4732       else if (tbf) then
4733         if(me.eq.king.or..not.out1file)then
4734          write (iout,'(a)') "Berendsen bath calculation"
4735          write (iout,'(a60,f10.5)') "Temperature:",t_bath
4736          write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath
4737          if (reset_moment) &
4738          write (iout,'(a,i10,a)') "Momenta will be reset at zero every",&
4739          count_reset_moment," steps"
4740          if (reset_vel) &
4741           write (iout,'(a,i10,a)') &
4742           "Velocities will be reset at random every",count_reset_vel,&
4743          " steps"
4744         endif
4745       else
4746         if(me.eq.king.or..not.out1file) &
4747          write (iout,'(a31)') "Microcanonical mode calculation"
4748       endif
4749       if(me.eq.king.or..not.out1file)then
4750        if (rest) write (iout,'(/a/)') "===== Calculation restarted ===="
4751        if (usampl) then
4752           write(iout,*) "MD running with constraints."
4753           write(iout,*) "Equilibration time ", eq_time, " mtus."
4754           write(iout,*) "Constraining ", nfrag," fragments."
4755           write(iout,*) "Length of each fragment, weight and q0:"
4756           do iset=1,nset
4757            write (iout,*) "Set of restraints #",iset
4758            do i=1,nfrag
4759               write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset),&
4760                  ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset)
4761            enddo
4762            write(iout,*) "constraints between ", npair, "fragments."
4763            write(iout,*) "constraint pairs, weights and q0:"
4764            do i=1,npair
4765             write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset),&
4766                    ipair(2,i,iset),wpair(i,iset),qinpair(i,iset)
4767            enddo
4768            write(iout,*) "angle constraints within ", nfrag_back,&
4769             "backbone fragments."
4770            write(iout,*) "fragment, weights:"
4771            do i=1,nfrag_back
4772             write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset),&
4773                ifrag_back(2,i,iset),wfrag_back(1,i,iset),&
4774                wfrag_back(2,i,iset),wfrag_back(3,i,iset)
4775            enddo
4776           enddo
4777         iset=mod(kolor,nset)+1
4778        endif
4779       endif
4780       if(me.eq.king.or..not.out1file) &
4781        write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup "
4782       return
4783       end subroutine read_MDpar
4784 !-----------------------------------------------------------------------------
4785       subroutine map_read
4786
4787       use map_data
4788 !      implicit real*8 (a-h,o-z)
4789 !      include 'DIMENSIONS'
4790 !      include 'COMMON.MAP'
4791 !      include 'COMMON.IOUNITS'
4792       character(len=3) :: angid(4) = (/'THE','PHI','ALP','OME'/)
4793       character(len=80) :: mapcard      !,ucase
4794 !el local variables
4795       integer :: imap
4796 !     real(kind=8) :: var,ene
4797
4798       do imap=1,nmap
4799         read (inp,'(a)') mapcard
4800         mapcard=ucase(mapcard)
4801         if (index(mapcard,'PHI').gt.0) then
4802           kang(imap)=1
4803         else if (index(mapcard,'THE').gt.0) then
4804           kang(imap)=2
4805         else if (index(mapcard,'ALP').gt.0) then
4806           kang(imap)=3
4807         else if (index(mapcard,'OME').gt.0) then
4808           kang(imap)=4
4809         else
4810           write(iout,'(a)')'Error - illegal variable spec in MAP card.'
4811           stop 'Error - illegal variable spec in MAP card.'
4812         endif
4813         call readi (mapcard,'RES1',res1(imap),0)
4814         call readi (mapcard,'RES2',res2(imap),0)
4815         if (res1(imap).eq.0) then
4816           res1(imap)=res2(imap)
4817         else if (res2(imap).eq.0) then
4818           res2(imap)=res1(imap)
4819         endif
4820         if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then
4821           write (iout,'(a)') &
4822           'Error - illegal definition of variable group in MAP.'
4823           stop 'Error - illegal definition of variable group in MAP.'
4824         endif
4825         call reada(mapcard,'FROM',ang_from(imap),0.0D0)
4826         call reada(mapcard,'TO',ang_to(imap),0.0D0)
4827         call readi(mapcard,'NSTEP',nstep(imap),0)
4828         if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then
4829           write (iout,'(a)') &
4830            'Illegal boundary and/or step size specification in MAP.'
4831           stop 'Illegal boundary and/or step size specification in MAP.'
4832         endif
4833       enddo ! imap
4834       return
4835       end subroutine map_read
4836 !-----------------------------------------------------------------------------
4837       subroutine csaread
4838
4839       use control_data, only: vdisulf
4840       use csa_data
4841 !      implicit real*8 (a-h,o-z)
4842 !      include 'DIMENSIONS'
4843 !      include 'COMMON.IOUNITS'
4844 !      include 'COMMON.GEO'
4845 !      include 'COMMON.CSA'
4846 !      include 'COMMON.BANK'
4847 !      include 'COMMON.CONTROL'
4848 !      character(len=80) :: ucase
4849       character(len=620) :: mcmcard
4850 !el local variables
4851 !     integer :: ntf,ik,iw_pdb
4852 !     real(kind=8) :: var,ene
4853
4854       call card_concat(mcmcard,.true.)
4855
4856       call readi(mcmcard,'NCONF',nconf,50)
4857       call readi(mcmcard,'NADD',nadd,0)
4858       call readi(mcmcard,'JSTART',jstart,1)
4859       call readi(mcmcard,'JEND',jend,1)
4860       call readi(mcmcard,'NSTMAX',nstmax,500000)
4861       call readi(mcmcard,'N0',n0,1)
4862       call readi(mcmcard,'N1',n1,6)
4863       call readi(mcmcard,'N2',n2,4)
4864       call readi(mcmcard,'N3',n3,0)
4865       call readi(mcmcard,'N4',n4,0)
4866       call readi(mcmcard,'N5',n5,0)
4867       call readi(mcmcard,'N6',n6,10)
4868       call readi(mcmcard,'N7',n7,0)
4869       call readi(mcmcard,'N8',n8,0)
4870       call readi(mcmcard,'N9',n9,0)
4871       call readi(mcmcard,'N14',n14,0)
4872       call readi(mcmcard,'N15',n15,0)
4873       call readi(mcmcard,'N16',n16,0)
4874       call readi(mcmcard,'N17',n17,0)
4875       call readi(mcmcard,'N18',n18,0)
4876
4877       vdisulf=(index(mcmcard,'DYNSS').gt.0)
4878
4879       call readi(mcmcard,'NDIFF',ndiff,2)
4880       call reada(mcmcard,'DIFFCUT',diffcut,0.0d0)
4881       call readi(mcmcard,'IS1',is1,1)
4882       call readi(mcmcard,'IS2',is2,8)
4883       call readi(mcmcard,'NRAN0',nran0,4)
4884       call readi(mcmcard,'NRAN1',nran1,2)
4885       call readi(mcmcard,'IRR',irr,1)
4886       call readi(mcmcard,'NSEED',nseed,20)
4887       call readi(mcmcard,'NTOTAL',ntotal,10000)
4888       call reada(mcmcard,'CUT1',cut1,2.0d0)
4889       call reada(mcmcard,'CUT2',cut2,5.0d0)
4890       call reada(mcmcard,'ESTOP',estop,-3000.0d0)
4891       call readi(mcmcard,'ICMAX',icmax,3)
4892       call readi(mcmcard,'IRESTART',irestart,0)
4893 !!bankt      call readi(mcmcard,'NBANKTM',ntbankm,0)
4894       ntbankm=0
4895 !!bankt
4896       call reada(mcmcard,'DELE',dele,20.0d0)
4897       call reada(mcmcard,'DIFCUT',difcut,720.0d0)
4898       call readi(mcmcard,'IREF',iref,0)
4899       call reada(mcmcard,'RMSCUT',rmscut,4.0d0)
4900       call reada(mcmcard,'PNCCUT',pnccut,0.5d0)
4901       call readi(mcmcard,'NCONF_IN',nconf_in,0)
4902       call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0)
4903       write (iout,*) "NCONF_IN",nconf_in
4904       return
4905       end subroutine csaread
4906 !-----------------------------------------------------------------------------
4907       subroutine mcmread
4908
4909       use mcm_data
4910       use control_data, only: MaxMoveType
4911       use MD_data
4912       use minim_data
4913 !      implicit real*8 (a-h,o-z)
4914 !      include 'DIMENSIONS'
4915 !      include 'COMMON.MCM'
4916 !      include 'COMMON.MCE'
4917 !      include 'COMMON.IOUNITS'
4918 !      character(len=80) :: ucase
4919       character(len=320) :: mcmcard
4920 !el local variables
4921       integer :: i
4922 !     real(kind=8) :: var,ene
4923
4924       call card_concat(mcmcard,.true.)
4925       call readi(mcmcard,'MAXACC',maxacc,100)
4926       call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000)
4927       call readi(mcmcard,'MAXTRIAL',maxtrial,100)
4928       call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000)
4929       call readi(mcmcard,'MAXREPM',maxrepm,200)
4930       call reada(mcmcard,'RANFRACT',RanFract,0.5D0)
4931       call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0)
4932       call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3)
4933       call reada(mcmcard,'E_UP',e_up,5.0D0)
4934       call reada(mcmcard,'DELTE',delte,0.1D0)
4935       call readi(mcmcard,'NSWEEP',nsweep,5)
4936       call readi(mcmcard,'NSTEPH',nsteph,0)
4937       call readi(mcmcard,'NSTEPC',nstepc,0)
4938       call reada(mcmcard,'TMIN',tmin,298.0D0)
4939       call reada(mcmcard,'TMAX',tmax,298.0D0)
4940       call readi(mcmcard,'NWINDOW',nwindow,0)
4941       call readi(mcmcard,'PRINT_MC',print_mc,0)
4942       print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0)
4943       print_int=(index(mcmcard,'NO_PRINT_INT').le.0)
4944       ent_read=(index(mcmcard,'ENT_READ').gt.0)
4945       call readi(mcmcard,'SAVE_FREQ',save_frequency,1000)
4946       call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000)
4947       call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000)
4948       call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000)
4949       call readi(mcmcard,'PRINT_FREQ',print_freq,1000)
4950       if (nwindow.gt.0) then
4951         allocate(winstart(nwindow))     !!el (maxres)
4952         allocate(winend(nwindow))       !!el
4953         allocate(winlen(nwindow))       !!el
4954         read (inp,*) (winstart(i),winend(i),i=1,nwindow)
4955         do i=1,nwindow
4956           winlen(i)=winend(i)-winstart(i)+1
4957         enddo
4958       endif
4959       if (tmax.lt.tmin) tmax=tmin
4960       if (tmax.eq.tmin) then
4961         nstepc=0
4962         nsteph=0
4963       endif
4964       if (nstepc.gt.0 .and. nsteph.gt.0) then
4965         tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0))
4966         tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0))
4967       endif
4968       allocate(sumpro_type(0:MaxMoveType)) !(0:MaxMoveType)
4969 ! Probabilities of different move types
4970       sumpro_type(0)=0.0D0
4971       call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0)
4972       call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0)
4973       sumpro_type(2)=sumpro_type(1)+sumpro_type(2)
4974       call reada(mcmcard,'THETA'     ,sumpro_type(3),0.0d0)
4975       sumpro_type(3)=sumpro_type(2)+sumpro_type(3)
4976       call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0)
4977       sumpro_type(4)=sumpro_type(3)+sumpro_type(4)
4978       do i=1,MaxMoveType
4979         print *,'i',i,' sumprotype',sumpro_type(i)
4980         sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType)
4981         print *,'i',i,' sumprotype',sumpro_type(i)
4982       enddo
4983       return
4984       end subroutine mcmread
4985 !-----------------------------------------------------------------------------
4986       subroutine read_minim
4987
4988       use minim_data
4989 !      implicit real*8 (a-h,o-z)
4990 !      include 'DIMENSIONS'
4991 !      include 'COMMON.MINIM'
4992 !      include 'COMMON.IOUNITS'
4993 !      character(len=80) :: ucase
4994       character(len=320) :: minimcard
4995 !el local variables
4996 !     integer :: ntf,ik,iw_pdb
4997 !     real(kind=8) :: var,ene
4998
4999       call card_concat(minimcard,.true.)
5000       call readi(minimcard,'MAXMIN',maxmin,2000)
5001       call readi(minimcard,'MAXFUN',maxfun,5000)
5002       call readi(minimcard,'MINMIN',minmin,maxmin)
5003       call readi(minimcard,'MINFUN',minfun,maxmin)
5004       call reada(minimcard,'TOLF',tolf,1.0D-2)
5005       call reada(minimcard,'RTOLF',rtolf,1.0D-4)
5006       print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1)
5007       print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1)
5008       print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1)
5009       write (iout,'(/80(1h*)/20x,a/80(1h*))') &
5010                'Options in energy minimization:'
5011       write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') &
5012        'MaxMin:',MaxMin,' MaxFun:',MaxFun,&
5013        'MinMin:',MinMin,' MinFun:',MinFun,&
5014        ' TolF:',TolF,' RTolF:',RTolF
5015       return
5016       end subroutine read_minim
5017 !-----------------------------------------------------------------------------
5018       subroutine openunits
5019
5020       use MD_data, only: usampl
5021       use csa_data
5022       use MPI_data
5023       use control_data, only:out1file
5024       use control, only: getenv_loc
5025 !      implicit real*8 (a-h,o-z)
5026 !      include 'DIMENSIONS'
5027 #ifdef MPI
5028       include 'mpif.h'
5029       character(len=16) :: form,nodename
5030       integer :: nodelen,ierror,npos
5031 #endif
5032 !      include 'COMMON.SETUP'
5033 !      include 'COMMON.IOUNITS'
5034 !      include 'COMMON.MD'
5035 !      include 'COMMON.CONTROL'
5036       integer :: lenpre,lenpot,lentmp   !,ilen
5037 !el      external ilen
5038       character(len=3) :: out1file_text !,ucase
5039       character(len=3) :: ll
5040 !el      external ucase
5041 !el local variables
5042 !     integer :: ntf,ik,iw_pdb
5043 !     real(kind=8) :: var,ene
5044 !
5045 !      print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits"
5046       call getenv_loc("PREFIX",prefix)
5047       pref_orig = prefix
5048       call getenv_loc("POT",pot)
5049       call getenv_loc("DIRTMP",tmpdir)
5050       call getenv_loc("CURDIR",curdir)
5051       call getenv_loc("OUT1FILE",out1file_text)
5052 !      print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV"
5053       out1file_text=ucase(out1file_text)
5054       if (out1file_text(1:1).eq."Y") then
5055         out1file=.true.
5056       else
5057         out1file=fg_rank.gt.0
5058       endif
5059       lenpre=ilen(prefix)
5060       lenpot=ilen(pot)
5061       lentmp=ilen(tmpdir)
5062       if (lentmp.gt.0) then
5063           write (*,'(80(1h!))')
5064           write (*,'(a,19x,a,19x,a)') "!","  A T T E N T I O N  ","!"
5065           write (*,'(80(1h!))')
5066           write (*,*)"All output files will be on node /tmp directory."
5067 #ifdef MPI
5068         call  MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR )
5069         if (me.eq.king) then
5070           write (*,*) "The master node is ",nodename
5071         else if (fg_rank.eq.0) then
5072           write (*,*) "I am the CG slave node ",nodename
5073         else
5074           write (*,*) "I am the FG slave node ",nodename
5075         endif
5076 #endif
5077         PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre)
5078         lenpre = lentmp+lenpre+1
5079       endif
5080       entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr'
5081 ! Get the names and open the input files
5082 #if defined(WINIFL) || defined(WINPGI)
5083       open(1,file=pref_orig(:ilen(pref_orig))// &
5084         '.inp',status='old',readonly,shared)
5085        open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5086 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5087 ! Get parameter filenames and open the parameter files.
5088       call getenv_loc('BONDPAR',bondname)
5089       open (ibond,file=bondname,status='old',readonly,shared)
5090       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5091       open (ibond_nucl,file=bondname_nucl,status='old',readonly,shared)
5092       call getenv_loc('THETPAR',thetname)
5093       open (ithep,file=thetname,status='old',readonly,shared)
5094       call getenv_loc('ROTPAR',rotname)
5095       open (irotam,file=rotname,status='old',readonly,shared)
5096       call getenv_loc('TORPAR',torname)
5097       open (itorp,file=torname,status='old',readonly,shared)
5098       call getenv_loc('TORDPAR',tordname)
5099       open (itordp,file=tordname,status='old',readonly,shared)
5100       call getenv_loc('FOURIER',fouriername)
5101       open (ifourier,file=fouriername,status='old',readonly,shared)
5102       call getenv_loc('ELEPAR',elename)
5103       open (ielep,file=elename,status='old',readonly,shared)
5104       call getenv_loc('SIDEPAR',sidename)
5105       open (isidep,file=sidename,status='old',readonly,shared)
5106
5107       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5108       open (ithep_nucl,file=thetname_nucl,status='old',readonly,shared)
5109       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5110       open (irotam_nucl,file=rotname_nucl,status='old',readonly,shared)
5111       call getenv_loc('TORPAR_NUCL',torname_nucl)
5112       open (itorp_nucl,file=torname_nucl,status='old',readonly,shared)
5113       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5114       open (itordp_nucl,file=tordname_nucl,status='old',readonly,shared)
5115       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5116       open (isidep_nucl,file=sidename_nucl,status='old',readonly,shared)
5117
5118
5119 #elif (defined CRAY) || (defined AIX)
5120       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
5121         action='read')
5122 !      print *,"Processor",myrank," opened file 1"
5123       open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5124 !      print *,"Processor",myrank," opened file 9"
5125 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5126 ! Get parameter filenames and open the parameter files.
5127       call getenv_loc('BONDPAR',bondname)
5128       open (ibond,file=bondname,status='old',action='read')
5129       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5130       open (ibond_nucl,file=bondname_nucl,status='old',action='read')
5131
5132 !      print *,"Processor",myrank," opened file IBOND"
5133       call getenv_loc('THETPAR',thetname)
5134       open (ithep,file=thetname,status='old',action='read')
5135 !      print *,"Processor",myrank," opened file ITHEP"
5136       call getenv_loc('ROTPAR',rotname)
5137       open (irotam,file=rotname,status='old',action='read')
5138 !      print *,"Processor",myrank," opened file IROTAM"
5139       call getenv_loc('TORPAR',torname)
5140       open (itorp,file=torname,status='old',action='read')
5141 !      print *,"Processor",myrank," opened file ITORP"
5142       call getenv_loc('TORDPAR',tordname)
5143       open (itordp,file=tordname,status='old',action='read')
5144 !      print *,"Processor",myrank," opened file ITORDP"
5145       call getenv_loc('SCCORPAR',sccorname)
5146       open (isccor,file=sccorname,status='old',action='read')
5147 !      print *,"Processor",myrank," opened file ISCCOR"
5148       call getenv_loc('FOURIER',fouriername)
5149       open (ifourier,file=fouriername,status='old',action='read')
5150 !      print *,"Processor",myrank," opened file IFOURIER"
5151       call getenv_loc('ELEPAR',elename)
5152       open (ielep,file=elename,status='old',action='read')
5153 !      print *,"Processor",myrank," opened file IELEP"
5154       call getenv_loc('SIDEPAR',sidename)
5155       open (isidep,file=sidename,status='old',action='read')
5156
5157       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5158       open (ithep_nucl,file=thetname_nucl,status='old',action='read')
5159       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5160       open (irotam_nucl,file=rotname_nucl,status='old',action='read')
5161       call getenv_loc('TORPAR_NUCL',torname_nucl)
5162       open (itorp_nucl,file=torname_nucl,status='old',action='read')
5163       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5164       open (itordp_nucl,file=tordname_nucl,status='old',action='read')
5165       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5166       open (isidep_nucl,file=sidename_nucl,status='old',action='read')
5167
5168       call getenv_loc('LIPTRANPAR',liptranname)
5169       open (iliptranpar,file=liptranname,status='old',action='read')
5170       call getenv_loc('TUBEPAR',tubename)
5171       open (itube,file=tubename,status='old',action='read')
5172       call getenv_loc('IONPAR',ionname)
5173       open (iion,file=ionname,status='old',action='read')
5174
5175 !      print *,"Processor",myrank," opened file ISIDEP"
5176 !      print *,"Processor",myrank," opened parameter files"
5177 #elif (defined G77)
5178       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old')
5179       open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5180 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5181 ! Get parameter filenames and open the parameter files.
5182       call getenv_loc('BONDPAR',bondname)
5183       open (ibond,file=bondname,status='old')
5184       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5185       open (ibond_nucl,file=bondname_nucl,status='old')
5186
5187       call getenv_loc('THETPAR',thetname)
5188       open (ithep,file=thetname,status='old')
5189       call getenv_loc('ROTPAR',rotname)
5190       open (irotam,file=rotname,status='old')
5191       call getenv_loc('TORPAR',torname)
5192       open (itorp,file=torname,status='old')
5193       call getenv_loc('TORDPAR',tordname)
5194       open (itordp,file=tordname,status='old')
5195       call getenv_loc('SCCORPAR',sccorname)
5196       open (isccor,file=sccorname,status='old')
5197       call getenv_loc('FOURIER',fouriername)
5198       open (ifourier,file=fouriername,status='old')
5199       call getenv_loc('ELEPAR',elename)
5200       open (ielep,file=elename,status='old')
5201       call getenv_loc('SIDEPAR',sidename)
5202       open (isidep,file=sidename,status='old')
5203
5204       open (ithep_nucl,file=thetname_nucl,status='old')
5205       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5206       open (irotam_nucl,file=rotname_nucl,status='old')
5207       call getenv_loc('TORPAR_NUCL',torname_nucl)
5208       open (itorp_nucl,file=torname_nucl,status='old')
5209       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5210       open (itordp_nucl,file=tordname_nucl,status='old')
5211       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5212       open (isidep_nucl,file=sidename_nucl,status='old')
5213
5214       call getenv_loc('LIPTRANPAR',liptranname)
5215       open (iliptranpar,file=liptranname,status='old')
5216       call getenv_loc('TUBEPAR',tubename)
5217       open (itube,file=tubename,status='old')
5218       call getenv_loc('IONPAR',ionname)
5219       open (iion,file=ionname,status='old')
5220 #else
5221       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
5222         readonly)
5223        open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5224 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5225 ! Get parameter filenames and open the parameter files.
5226       call getenv_loc('BONDPAR',bondname)
5227       open (ibond,file=bondname,status='old',action='read')
5228       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5229       open (ibond_nucl,file=bondname_nucl,status='old',action='read')
5230       call getenv_loc('THETPAR',thetname)
5231       open (ithep,file=thetname,status='old',action='read')
5232       call getenv_loc('ROTPAR',rotname)
5233       open (irotam,file=rotname,status='old',action='read')
5234       call getenv_loc('TORPAR',torname)
5235       open (itorp,file=torname,status='old',action='read')
5236       call getenv_loc('TORDPAR',tordname)
5237       open (itordp,file=tordname,status='old',action='read')
5238       call getenv_loc('SCCORPAR',sccorname)
5239       open (isccor,file=sccorname,status='old',action='read')
5240 #ifndef CRYST_THETA
5241       call getenv_loc('THETPARPDB',thetname_pdb)
5242       print *,"thetname_pdb ",thetname_pdb
5243       open (ithep_pdb,file=thetname_pdb,status='old',action='read')
5244       print *,ithep_pdb," opened"
5245 #endif
5246       call getenv_loc('FOURIER',fouriername)
5247       open (ifourier,file=fouriername,status='old',readonly)
5248       call getenv_loc('ELEPAR',elename)
5249       open (ielep,file=elename,status='old',readonly)
5250       call getenv_loc('SIDEPAR',sidename)
5251       open (isidep,file=sidename,status='old',readonly)
5252
5253       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5254       open (ithep_nucl,file=thetname_nucl,status='old',action='read')
5255       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5256       open (irotam_nucl,file=rotname_nucl,status='old',action='read')
5257       call getenv_loc('TORPAR_NUCL',torname_nucl)
5258       open (itorp_nucl,file=torname_nucl,status='old',action='read')
5259       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5260       open (itordp_nucl,file=tordname_nucl,status='old',action='read')
5261       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5262       open (isidep_nucl,file=sidename_nucl,status='old',action='read')
5263       call getenv_loc('SIDEPAR_SCBASE',sidename_scbase)
5264       open (isidep_scbase,file=sidename_scbase,status='old',action='read')
5265       call getenv_loc('PEPPAR_PEPBASE',pepname_pepbase)
5266       open (isidep_pepbase,file=pepname_pepbase,status='old',action='read')
5267       call getenv_loc('SCPAR_PHOSPH',pepname_scpho)
5268       open (isidep_scpho,file=pepname_scpho,status='old',action='read')
5269       call getenv_loc('PEPPAR_PHOSPH',pepname_peppho)
5270       open (isidep_peppho,file=pepname_peppho,status='old',action='read')
5271
5272
5273       call getenv_loc('LIPTRANPAR',liptranname)
5274       open (iliptranpar,file=liptranname,status='old',action='read')
5275       call getenv_loc('TUBEPAR',tubename)
5276       open (itube,file=tubename,status='old',action='read')
5277       call getenv_loc('IONPAR',ionname)
5278       open (iion,file=ionname,status='old',action='read')
5279
5280 #ifndef CRYST_SC
5281       call getenv_loc('ROTPARPDB',rotname_pdb)
5282       open (irotam_pdb,file=rotname_pdb,status='old',action='read')
5283 #endif
5284 #endif
5285       call getenv_loc('SCPPAR_NUCL',scpname_nucl)
5286 #if defined(WINIFL) || defined(WINPGI)
5287       open (iscpp_nucl,file=scpname_nucl,status='old',readonly,shared)
5288 #elif (defined CRAY)  || (defined AIX)
5289       open (iscpp_nucl,file=scpname_nucl,status='old',action='read')
5290 #elif (defined G77)
5291       open (iscpp_nucl,file=scpname_nucl,status='old')
5292 #else
5293       open (iscpp_nucl,file=scpname_nucl,status='old',action='read')
5294 #endif
5295
5296 #ifndef OLDSCP
5297 !
5298 ! 8/9/01 In the newest version SCp interaction constants are read from a file
5299 ! Use -DOLDSCP to use hard-coded constants instead.
5300 !
5301       call getenv_loc('SCPPAR',scpname)
5302 #if defined(WINIFL) || defined(WINPGI)
5303       open (iscpp,file=scpname,status='old',readonly,shared)
5304 #elif (defined CRAY)  || (defined AIX)
5305       open (iscpp,file=scpname,status='old',action='read')
5306 #elif (defined G77)
5307       open (iscpp,file=scpname,status='old')
5308 #else
5309       open (iscpp,file=scpname,status='old',action='read')
5310 #endif
5311 #endif
5312       call getenv_loc('PATTERN',patname)
5313 #if defined(WINIFL) || defined(WINPGI)
5314       open (icbase,file=patname,status='old',readonly,shared)
5315 #elif (defined CRAY)  || (defined AIX)
5316       open (icbase,file=patname,status='old',action='read')
5317 #elif (defined G77)
5318       open (icbase,file=patname,status='old')
5319 #else
5320       open (icbase,file=patname,status='old',action='read')
5321 #endif
5322 #ifdef MPI
5323 ! Open output file only for CG processes
5324 !      print *,"Processor",myrank," fg_rank",fg_rank
5325       if (fg_rank.eq.0) then
5326
5327       if (nodes.eq.1) then
5328         npos=3
5329       else
5330         npos = dlog10(dfloat(nodes-1))+1
5331       endif
5332       if (npos.lt.3) npos=3
5333       write (liczba,'(i1)') npos
5334       form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) &
5335         //')'
5336       write (liczba,form) me
5337       outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// &
5338         liczba(:ilen(liczba))
5339       intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) &
5340         //'.int'
5341       pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) &
5342         //'.pdb'
5343       mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// &
5344         liczba(:ilen(liczba))//'.mol2'
5345       statname=prefix(:lenpre)//'_'//pot(:lenpot)// &
5346         liczba(:ilen(liczba))//'.stat'
5347       if (lentmp.gt.0) &
5348         call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) &
5349             //liczba(:ilen(liczba))//'.stat')
5350       rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) &
5351         //'.rst'
5352       if(usampl) then
5353           qname=prefix(:lenpre)//'_'//pot(:lenpot)// &
5354        liczba(:ilen(liczba))//'.const'
5355       endif
5356
5357       endif
5358 #else
5359       outname=prefix(:lenpre)//'.out_'//pot(:lenpot)
5360       intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int'
5361       pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb'
5362       mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2'
5363       statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat'
5364       if (lentmp.gt.0) &
5365         call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)// &
5366           '.stat')
5367       rest2name=prefix(:ilen(prefix))//'.rst'
5368       if(usampl) then
5369          qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const'
5370       endif
5371 #endif
5372 #if defined(AIX) || defined(PGI)
5373       if (me.eq.king .or. .not. out1file) &
5374          open(iout,file=outname,status='unknown')
5375 #ifdef DEBUG
5376       if (fg_rank.gt.0) then
5377         write (liczba,'(i3.3)') myrank/nfgtasks
5378         write (ll,'(bz,i3.3)') fg_rank
5379         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,&
5380          status='unknown')
5381       endif
5382 #endif
5383       if(me.eq.king) then
5384        open(igeom,file=intname,status='unknown',position='append')
5385        open(ipdb,file=pdbname,status='unknown')
5386        open(imol2,file=mol2name,status='unknown')
5387        open(istat,file=statname,status='unknown',position='append')
5388       else
5389 !1out       open(iout,file=outname,status='unknown')
5390       endif
5391 #else
5392       if (me.eq.king .or. .not.out1file) &
5393           open(iout,file=outname,status='unknown')
5394 #ifdef DEBUG
5395       if (fg_rank.gt.0) then
5396         write (liczba,'(i3.3)') myrank/nfgtasks
5397         write (ll,'(bz,i3.3)') fg_rank
5398         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,&
5399          status='unknown')
5400       endif
5401 #endif
5402       if(me.eq.king) then
5403        open(igeom,file=intname,status='unknown',access='append')
5404        open(ipdb,file=pdbname,status='unknown')
5405        open(imol2,file=mol2name,status='unknown')
5406        open(istat,file=statname,status='unknown',access='append')
5407       else
5408 !1out       open(iout,file=outname,status='unknown')
5409       endif
5410 #endif
5411       csa_rbank=prefix(:lenpre)//'.CSA.rbank'
5412       csa_seed=prefix(:lenpre)//'.CSA.seed'
5413       csa_history=prefix(:lenpre)//'.CSA.history'
5414       csa_bank=prefix(:lenpre)//'.CSA.bank'
5415       csa_bank1=prefix(:lenpre)//'.CSA.bank1'
5416       csa_alpha=prefix(:lenpre)//'.CSA.alpha'
5417       csa_alpha1=prefix(:lenpre)//'.CSA.alpha1'
5418 !!bankt      csa_bankt=prefix(:lenpre)//'.CSA.bankt'
5419       csa_int=prefix(:lenpre)//'.int'
5420       csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized'
5421       csa_native_int=prefix(:lenpre)//'.CSA.native.int'
5422       csa_in=prefix(:lenpre)//'.CSA.in'
5423 !      print *,"Processor",myrank,"fg_rank",fg_rank," opened files"
5424 ! Write file names
5425       if (me.eq.king)then
5426       write (iout,'(80(1h-))')
5427       write (iout,'(30x,a)') "FILE ASSIGNMENT"
5428       write (iout,'(80(1h-))')
5429       write (iout,*) "Input file                      : ",&
5430         pref_orig(:ilen(pref_orig))//'.inp'
5431       write (iout,*) "Output file                     : ",&
5432         outname(:ilen(outname))
5433       write (iout,*)
5434       write (iout,*) "Sidechain potential file        : ",&
5435         sidename(:ilen(sidename))
5436 #ifndef OLDSCP
5437       write (iout,*) "SCp potential file              : ",&
5438         scpname(:ilen(scpname))
5439 #endif
5440       write (iout,*) "Electrostatic potential file    : ",&
5441         elename(:ilen(elename))
5442       write (iout,*) "Cumulant coefficient file       : ",&
5443         fouriername(:ilen(fouriername))
5444       write (iout,*) "Torsional parameter file        : ",&
5445         torname(:ilen(torname))
5446       write (iout,*) "Double torsional parameter file : ",&
5447         tordname(:ilen(tordname))
5448       write (iout,*) "SCCOR parameter file : ",&
5449         sccorname(:ilen(sccorname))
5450       write (iout,*) "Bond & inertia constant file    : ",&
5451         bondname(:ilen(bondname))
5452       write (iout,*) "Bending parameter file          : ",&
5453         thetname(:ilen(thetname))
5454       write (iout,*) "Rotamer parameter file          : ",&
5455         rotname(:ilen(rotname))
5456 !el----
5457 #ifndef CRYST_THETA
5458       write (iout,*) "Thetpdb parameter file          : ",&
5459         thetname_pdb(:ilen(thetname_pdb))
5460 #endif
5461 !el
5462       write (iout,*) "Threading database              : ",&
5463         patname(:ilen(patname))
5464       if (lentmp.ne.0) &
5465       write (iout,*)" DIRTMP                          : ",&
5466         tmpdir(:lentmp)
5467       write (iout,'(80(1h-))')
5468       endif
5469       return
5470       end subroutine openunits
5471 !-----------------------------------------------------------------------------
5472       subroutine readrst
5473
5474       use geometry_data, only: nres,dc
5475       use MD_data
5476 !      implicit real*8 (a-h,o-z)
5477 !      include 'DIMENSIONS'
5478 !      include 'COMMON.CHAIN'
5479 !      include 'COMMON.IOUNITS'
5480 !      include 'COMMON.MD'
5481 !el local variables
5482       integer ::i,j
5483 !     real(kind=8) :: var,ene
5484
5485       open(irest2,file=rest2name,status='unknown')
5486       read(irest2,*) totT,EK,potE,totE,t_bath
5487       totTafm=totT
5488 !      do i=1,2*nres
5489 ! AL 4/17/17: Now reading d_t(0,:) too
5490       do i=0,2*nres
5491          read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
5492       enddo
5493 !      do i=1,2*nres
5494 ! AL 4/17/17: Now reading d_c(0,:) too
5495       do i=0,2*nres
5496          read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
5497       enddo
5498       if(usampl) then
5499              read (irest2,*) iset
5500       endif
5501       close(irest2)
5502       return
5503       end subroutine readrst
5504 !-----------------------------------------------------------------------------
5505       subroutine read_fragments
5506
5507       use energy_data
5508 !      use geometry
5509       use control_data, only:out1file
5510       use MD_data
5511       use MPI_data
5512 !      implicit real*8 (a-h,o-z)
5513 !      include 'DIMENSIONS'
5514 #ifdef MPI
5515       include 'mpif.h'
5516 #endif
5517 !      include 'COMMON.SETUP'
5518 !      include 'COMMON.CHAIN'
5519 !      include 'COMMON.IOUNITS'
5520 !      include 'COMMON.MD'
5521 !      include 'COMMON.CONTROL'
5522 !el local variables
5523       integer :: i
5524 !     real(kind=8) :: var,ene
5525
5526       read(inp,*) nset,nfrag,npair,nfrag_back
5527
5528 !el from module energy
5529 !      if(.not.allocated(mset)) allocate(mset(nset))  !(maxprocs/20)
5530       if(.not.allocated(wfrag_back)) then
5531         allocate(wfrag_back(3,nfrag_back,nset)) !(3,maxfrag_back,maxprocs/20)
5532         allocate(ifrag_back(3,nfrag_back,nset)) !(3,maxfrag_back,maxprocs/20)
5533
5534         allocate(qinfrag(nfrag,nset),wfrag(nfrag,nset)) !(50,maxprocs/20)
5535         allocate(ifrag(2,nfrag,nset))  !(2,50,maxprocs/20)
5536
5537         allocate(qinpair(npair,nset),wpair(npair,nset)) !(100,maxprocs/20)
5538         allocate(ipair(2,npair,nset))  !(2,100,maxprocs/20)
5539       endif
5540
5541       if(me.eq.king.or..not.out1file) &
5542        write(iout,*) "nset",nset," nfrag",nfrag," npair",npair,&
5543         " nfrag_back",nfrag_back
5544       do iset=1,nset
5545          read(inp,*) mset(iset)
5546        do i=1,nfrag
5547          read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset),&
5548            qinfrag(i,iset)
5549          if(me.eq.king.or..not.out1file) &
5550           write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset),&
5551            ifrag(2,i,iset), qinfrag(i,iset)
5552        enddo
5553        do i=1,npair
5554         read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset),&
5555           qinpair(i,iset)
5556         if(me.eq.king.or..not.out1file) &
5557          write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset),&
5558           ipair(2,i,iset), qinpair(i,iset)
5559        enddo
5560        do i=1,nfrag_back
5561         read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset),&
5562            wfrag_back(3,i,iset),&
5563            ifrag_back(1,i,iset),ifrag_back(2,i,iset)
5564         if(me.eq.king.or..not.out1file) &
5565          write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset),&
5566          wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset)
5567        enddo
5568       enddo
5569       return
5570       end subroutine read_fragments
5571 !-----------------------------------------------------------------------------
5572 ! shift.F       io_csa
5573 !-----------------------------------------------------------------------------
5574       subroutine csa_read
5575
5576       use csa_data
5577 !      implicit real*8 (a-h,o-z)
5578 !      include 'DIMENSIONS'
5579 !      include 'COMMON.CSA'
5580 !      include 'COMMON.BANK'
5581 !      include 'COMMON.IOUNITS'
5582 !el local variables
5583 !     integer :: ntf,ik,iw_pdb
5584 !     real(kind=8) :: var,ene
5585
5586       open(icsa_in,file=csa_in,status="old",err=100)
5587        read(icsa_in,*) nconf
5588        read(icsa_in,*) jstart,jend
5589        read(icsa_in,*) nstmax
5590        read(icsa_in,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5591        read(icsa_in,*) nran0,nran1,irr
5592        read(icsa_in,*) nseed
5593        read(icsa_in,*) ntotal,cut1,cut2
5594        read(icsa_in,*) estop
5595        read(icsa_in,*) icmax,irestart
5596        read(icsa_in,*) ntbankm,dele,difcut
5597        read(icsa_in,*) iref,rmscut,pnccut
5598        read(icsa_in,*) ndiff
5599       close(icsa_in)
5600
5601       return
5602
5603  100  continue
5604       return
5605       end subroutine csa_read
5606 !-----------------------------------------------------------------------------
5607       subroutine initial_write
5608
5609       use csa_data
5610 !      implicit real*8 (a-h,o-z)
5611 !      include 'DIMENSIONS'
5612 !      include 'COMMON.CSA'
5613 !      include 'COMMON.BANK'
5614 !      include 'COMMON.IOUNITS'
5615 !el local variables
5616 !     integer :: ntf,ik,iw_pdb
5617 !     real(kind=8) :: var,ene
5618
5619       open(icsa_seed,file=csa_seed,status="unknown")
5620        write(icsa_seed,*) "seed"
5621       close(31)
5622 #if defined(AIX) || defined(PGI)
5623        open(icsa_history,file=csa_history,status="unknown",&
5624         position="append")
5625 #else
5626        open(icsa_history,file=csa_history,status="unknown",&
5627         access="append")
5628 #endif
5629        write(icsa_history,*) nconf
5630        write(icsa_history,*) jstart,jend
5631        write(icsa_history,*) nstmax
5632        write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5633        write(icsa_history,*) nran0,nran1,irr
5634        write(icsa_history,*) nseed
5635        write(icsa_history,*) ntotal,cut1,cut2
5636        write(icsa_history,*) estop
5637        write(icsa_history,*) icmax,irestart
5638        write(icsa_history,*) ntbankm,dele,difcut
5639        write(icsa_history,*) iref,rmscut,pnccut
5640        write(icsa_history,*) ndiff
5641
5642        write(icsa_history,*)
5643       close(icsa_history)
5644
5645       open(icsa_bank1,file=csa_bank1,status="unknown")
5646        write(icsa_bank1,*) 0
5647       close(icsa_bank1)
5648
5649       return
5650       end subroutine initial_write
5651 !-----------------------------------------------------------------------------
5652       subroutine restart_write
5653
5654       use csa_data
5655 !      implicit real*8 (a-h,o-z)
5656 !      include 'DIMENSIONS'
5657 !      include 'COMMON.IOUNITS'
5658 !      include 'COMMON.CSA'
5659 !      include 'COMMON.BANK'
5660 !el local variables
5661 !     integer :: ntf,ik,iw_pdb
5662 !     real(kind=8) :: var,ene
5663
5664 #if defined(AIX) || defined(PGI)
5665        open(icsa_history,file=csa_history,position="append")
5666 #else
5667        open(icsa_history,file=csa_history,access="append")
5668 #endif
5669        write(icsa_history,*)
5670        write(icsa_history,*) "This is restart"
5671        write(icsa_history,*)
5672        write(icsa_history,*) nconf
5673        write(icsa_history,*) jstart,jend
5674        write(icsa_history,*) nstmax
5675        write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5676        write(icsa_history,*) nran0,nran1,irr
5677        write(icsa_history,*) nseed
5678        write(icsa_history,*) ntotal,cut1,cut2
5679        write(icsa_history,*) estop
5680        write(icsa_history,*) icmax,irestart
5681        write(icsa_history,*) ntbankm,dele,difcut
5682        write(icsa_history,*) iref,rmscut,pnccut
5683        write(icsa_history,*) ndiff
5684        write(icsa_history,*)
5685        write(icsa_history,*) "irestart is: ", irestart
5686
5687        write(icsa_history,*)
5688       close(icsa_history)
5689
5690       return
5691       end subroutine restart_write
5692 !-----------------------------------------------------------------------------
5693 ! test.F
5694 !-----------------------------------------------------------------------------
5695       subroutine write_pdb(npdb,titelloc,ee)
5696
5697 !      implicit real*8 (a-h,o-z)
5698 !      include 'DIMENSIONS'
5699 !      include 'COMMON.IOUNITS'
5700       character(len=50) :: titelloc1
5701       character*(*) :: titelloc
5702       character(len=3) :: zahl
5703       character(len=5) :: liczba5
5704       real(kind=8) :: ee
5705       integer :: npdb   !,ilen
5706 !el      external ilen
5707 !el local variables
5708       integer :: lenpre
5709 !     real(kind=8) :: var,ene
5710
5711       titelloc1=titelloc
5712       lenpre=ilen(prefix)
5713       if (npdb.lt.1000) then
5714        call numstr(npdb,zahl)
5715        open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
5716       else
5717         if (npdb.lt.10000) then
5718          write(liczba5,'(i1,i4)') 0,npdb
5719         else
5720          write(liczba5,'(i5)') npdb
5721         endif
5722         open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
5723       endif
5724       call pdbout(ee,titelloc1,ipdb)
5725       close(ipdb)
5726       return
5727       end subroutine write_pdb
5728 !-----------------------------------------------------------------------------
5729 ! thread.F
5730 !-----------------------------------------------------------------------------
5731       subroutine write_thread_summary
5732 ! Thread the sequence through a database of known structures
5733       use control_data, only: refstr
5734 !      use geometry
5735       use energy_data, only: n_ene_comp
5736       use compare_data
5737 !      implicit real*8 (a-h,o-z)
5738 !      include 'DIMENSIONS'
5739 #ifdef MPI
5740       use MPI_data      !include 'COMMON.INFO'
5741       include 'mpif.h'
5742 #endif
5743 !      include 'COMMON.CONTROL'
5744 !      include 'COMMON.CHAIN'
5745 !      include 'COMMON.DBASE'
5746 !      include 'COMMON.INTERACT'
5747 !      include 'COMMON.VAR'
5748 !      include 'COMMON.THREAD'
5749 !      include 'COMMON.FFIELD'
5750 !      include 'COMMON.SBRIDGE'
5751 !      include 'COMMON.HEADER'
5752 !      include 'COMMON.NAMES'
5753 !      include 'COMMON.IOUNITS'
5754 !      include 'COMMON.TIME1'
5755
5756       integer,dimension(maxthread) :: ip
5757       real(kind=8),dimension(0:n_ene) :: energia
5758 !el local variables
5759       integer :: i,j,ii,jj,ipj,ik,kk,ist
5760       real(kind=8) :: enet,etot,rmsnat,rms,frac,frac_nn
5761
5762       write (iout,'(30x,a/)') &
5763        '  *********** Summary threading statistics ************'
5764       write (iout,'(a)') 'Initial energies:'
5765       write (iout,'(a4,2x,a12,14a14,3a8)') &
5766        'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT',&
5767        'RMSnat','NatCONT','NNCONT','RMS'
5768 ! Energy sort patterns
5769       do i=1,nthread
5770         ip(i)=i
5771       enddo
5772       do i=1,nthread-1
5773         enet=ener(n_ene-1,ip(i))
5774         jj=i
5775         do j=i+1,nthread
5776           if (ener(n_ene-1,ip(j)).lt.enet) then
5777             jj=j
5778             enet=ener(n_ene-1,ip(j))
5779           endif
5780         enddo
5781         if (jj.ne.i) then
5782           ipj=ip(jj)
5783           ip(jj)=ip(i)
5784           ip(i)=ipj
5785         endif
5786       enddo
5787       do ik=1,nthread
5788         i=ip(ik)
5789         ii=ipatt(1,i)
5790         ist=nres_base(2,ii)+ipatt(2,i)
5791         do kk=1,n_ene_comp
5792           energia(i)=ener0(kk,i)
5793         enddo
5794         etot=ener0(n_ene_comp+1,i)
5795         rmsnat=ener0(n_ene_comp+2,i)
5796         rms=ener0(n_ene_comp+3,i)
5797         frac=ener0(n_ene_comp+4,i)
5798         frac_nn=ener0(n_ene_comp+5,i)
5799
5800         if (refstr) then
5801         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5802         i,str_nam(ii),ist+1,&
5803         (energia(print_order(kk)),kk=1,nprint_ene),&
5804         etot,rmsnat,frac,frac_nn,rms
5805         else
5806         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)') &
5807         i,str_nam(ii),ist+1,&
5808         (energia(print_order(kk)),kk=1,nprint_ene),etot
5809         endif
5810       enddo
5811       write (iout,'(//a)') 'Final energies:'
5812       write (iout,'(a4,2x,a12,17a14,3a8)') &
5813        'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT',&
5814        'RMSnat','NatCONT','NNCONT','RMS'
5815       do ik=1,nthread
5816         i=ip(ik)
5817         ii=ipatt(1,i)
5818         ist=nres_base(2,ii)+ipatt(2,i)
5819         do kk=1,n_ene_comp
5820           energia(kk)=ener(kk,ik)
5821         enddo
5822         etot=ener(n_ene_comp+1,i)
5823         rmsnat=ener(n_ene_comp+2,i)
5824         rms=ener(n_ene_comp+3,i)
5825         frac=ener(n_ene_comp+4,i)
5826         frac_nn=ener(n_ene_comp+5,i)
5827         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5828         i,str_nam(ii),ist+1,&
5829         (energia(print_order(kk)),kk=1,nprint_ene),&
5830         etot,rmsnat,frac,frac_nn,rms
5831       enddo
5832       write (iout,'(/a/)') 'IEXAM array:'
5833       write (iout,'(i5)') nexcl
5834       do i=1,nexcl
5835         write (iout,'(2i5)') iexam(1,i),iexam(2,i)
5836       enddo
5837       write (iout,'(/a,1pe14.4/a,1pe14.4/)') &
5838        'Max. time for threading step ',max_time_for_thread,&
5839        'Average time for threading step: ',ave_time_for_thread
5840       return
5841       end subroutine write_thread_summary
5842 !-----------------------------------------------------------------------------
5843       subroutine write_stat_thread(ithread,ipattern,ist)
5844
5845       use energy_data, only: n_ene_comp
5846       use compare_data
5847 !      implicit real*8 (a-h,o-z)
5848 !      include "DIMENSIONS"
5849 !      include "COMMON.CONTROL"
5850 !      include "COMMON.IOUNITS"
5851 !      include "COMMON.THREAD"
5852 !      include "COMMON.FFIELD"
5853 !      include "COMMON.DBASE"
5854 !      include "COMMON.NAMES"
5855       real(kind=8),dimension(0:n_ene) :: energia
5856 !el local variables
5857       integer :: ithread,ipattern,ist,i
5858       real(kind=8) :: etot,rmsnat,rms,frac,frac_nn
5859
5860 #if defined(AIX) || defined(PGI)
5861       open(istat,file=statname,position='append')
5862 #else
5863       open(istat,file=statname,access='append')
5864 #endif
5865       do i=1,n_ene_comp
5866         energia(i)=ener(i,ithread)
5867       enddo
5868       etot=ener(n_ene_comp+1,ithread)
5869       rmsnat=ener(n_ene_comp+2,ithread)
5870       rms=ener(n_ene_comp+3,ithread)
5871       frac=ener(n_ene_comp+4,ithread)
5872       frac_nn=ener(n_ene_comp+5,ithread)
5873       write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5874         ithread,str_nam(ipattern),ist+1,&
5875         (energia(print_order(i)),i=1,nprint_ene),&
5876         etot,rmsnat,frac,frac_nn,rms
5877       close (istat)
5878       return
5879       end subroutine write_stat_thread
5880 !-----------------------------------------------------------------------------
5881 #endif
5882 !-----------------------------------------------------------------------------
5883       end module io_config