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