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