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