source/unres/io_config.F90

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