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
4181       call int_from_cart(.true.,.false.)
4182       call sc_loc_geom(.false.)
4183       do i=1,nres
4184         thetaref(i)=theta(i)
4185         phiref(i)=phi(i)
4186       enddo
4187 !      do i=1,2*nres
4188 !        vbld_inv(i)=0.d0
4189 !        vbld(i)=0.d0
4190 !      enddo
4191
4192       do i=1,nres-1
4193         do j=1,3
4194           dc(j,i)=c(j,i+1)-c(j,i)
4195           dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
4196         enddo
4197       enddo
4198       do i=2,nres-1
4199         do j=1,3
4200           dc(j,i+nres)=c(j,i+nres)-c(j,i)
4201           dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
4202         enddo
4203 !      write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),&
4204 !        vbld_inv(i+nres)
4205       enddo
4206 !      call chainbuild
4207 ! Copy the coordinates to reference coordinates
4208 ! Splits to single chain if occurs
4209
4210 !      do i=1,2*nres
4211 !        do j=1,3
4212 !          cref(j,i,cou)=c(j,i)
4213 !        enddo
4214 !      enddo
4215 !
4216       if(.not.allocated(cref)) allocate(cref(3,2*nres+2,maxperm)) !(3,maxres2+2,maxperm)
4217       if(.not.allocated(chain_rep)) allocate(chain_rep(3,2*nres+2,maxsym)) !(3,maxres2+2,maxsym)
4218       if(.not.allocated(tabperm)) allocate(tabperm(maxperm,maxsym)) !(maxperm,maxsym)
4219 !-----------------------------
4220       kkk=1
4221       lll=0
4222       cou=1
4223         write (iout,*) "symetr", symetr
4224       do i=1,nres
4225       lll=lll+1
4226 !      write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
4227       if (i.gt.1) then
4228       if ((itype(i-1,1).eq.ntyp1).and.(i.gt.2)) then
4229       chain_length=lll-1
4230       kkk=kkk+1
4231 !       write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
4232       lll=1
4233       endif
4234       endif
4235         do j=1,3
4236           cref(j,i,cou)=c(j,i)
4237           cref(j,i+nres,cou)=c(j,i+nres)
4238           if (i.le.nres) then
4239           chain_rep(j,lll,kkk)=c(j,i)
4240           chain_rep(j,lll+nres,kkk)=c(j,i+nres)
4241           endif
4242          enddo
4243       enddo
4244       write (iout,*) chain_length
4245       if (chain_length.eq.0) chain_length=nres
4246       do j=1,3
4247       chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
4248       chain_rep(j,chain_length+nres,symetr) &
4249       =chain_rep(j,chain_length+nres,1)
4250       enddo
4251 ! diagnostic
4252 !       write (iout,*) "spraw lancuchy",chain_length,symetr
4253 !       do i=1,4
4254 !         do kkk=1,chain_length
4255 !           write (iout,*) itype(kkk,1),(chain_rep(j,kkk,i), j=1,3)
4256 !         enddo
4257 !        enddo
4258 ! enddiagnostic
4259 ! makes copy of chains
4260         write (iout,*) "symetr", symetr
4261       do j=1,3
4262       dc(j,0)=c(j,1)
4263       enddo
4264
4265       if (symetr.gt.1) then
4266        call permut(symetr)
4267        nperm=1
4268        do i=1,symetr
4269        nperm=nperm*i
4270        enddo
4271        do i=1,nperm
4272        write(iout,*) (tabperm(i,kkk),kkk=1,4)
4273        enddo
4274        do i=1,nperm
4275         cou=0
4276         do kkk=1,symetr
4277          icha=tabperm(i,kkk)
4278          write (iout,*) i,icha
4279          do lll=1,chain_length
4280           cou=cou+1
4281            if (cou.le.nres) then
4282            do j=1,3
4283             kupa=mod(lll,chain_length)
4284             iprzes=(kkk-1)*chain_length+lll
4285             if (kupa.eq.0) kupa=chain_length
4286             write (iout,*) "kupa", kupa
4287             cref(j,iprzes,i)=chain_rep(j,kupa,icha)
4288             cref(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha)
4289           enddo
4290           endif
4291          enddo
4292         enddo
4293        enddo
4294        endif
4295 !-koniec robienia kopii
4296 ! diag
4297       do kkk=1,nperm
4298       write (iout,*) "nowa struktura", nperm
4299       do i=1,nres
4300         write (iout,110) restyp(itype(i,1),1),i,cref(1,i,kkk),&
4301       cref(2,i,kkk),&
4302       cref(3,i,kkk),cref(1,nres+i,kkk),&
4303       cref(2,nres+i,kkk),cref(3,nres+i,kkk)
4304       enddo
4305   100 format (//'                alpha-carbon coordinates       ',&
4306                 '     centroid coordinates'/ &
4307                 '       ', 6X,'X',11X,'Y',11X,'Z', &
4308                                 10X,'X',11X,'Y',11X,'Z')
4309   110 format (a,'(',i5,')',6f12.5)
4310
4311       enddo
4312 !c enddiag
4313       do j=1,nbfrag
4314         do i=1,4
4315          bfrag(i,j)=bfrag(i,j)-ishift
4316         enddo
4317       enddo
4318
4319       do j=1,nhfrag
4320         do i=1,2
4321          hfrag(i,j)=hfrag(i,j)-ishift
4322         enddo
4323       enddo
4324       ishift_pdb=ishift
4325
4326       return
4327       end subroutine readpdb
4328 #if .not. defined(WHAM_RUN) && .not. defined(CLUSTER)
4329 !-----------------------------------------------------------------------------
4330 ! readrtns_CSA.F
4331 !-----------------------------------------------------------------------------
4332       subroutine read_control
4333 !
4334 ! Read contorl data
4335 !
4336 !      use geometry_data
4337       use comm_machsw
4338       use energy_data
4339       use control_data
4340       use compare_data
4341       use MCM_data
4342       use map_data
4343       use csa_data
4344       use MD_data
4345       use MPI_data
4346       use random, only: random_init
4347 !      implicit real*8 (a-h,o-z)
4348 !      include 'DIMENSIONS'
4349 #ifdef MP
4350       use prng, only:prng_restart
4351       include 'mpif.h'
4352       logical :: OKRandom!, prng_restart
4353       real(kind=8) :: r1
4354 #endif
4355 !      include 'COMMON.IOUNITS'
4356 !      include 'COMMON.TIME1'
4357 !      include 'COMMON.THREAD'
4358 !      include 'COMMON.SBRIDGE'
4359 !      include 'COMMON.CONTROL'
4360 !      include 'COMMON.MCM'
4361 !      include 'COMMON.MAP'
4362 !      include 'COMMON.HEADER'
4363 !      include 'COMMON.CSA'
4364 !      include 'COMMON.CHAIN'
4365 !      include 'COMMON.MUCA'
4366 !      include 'COMMON.MD'
4367 !      include 'COMMON.FFIELD'
4368 !      include 'COMMON.INTERACT'
4369 !      include 'COMMON.SETUP'
4370 !el      integer :: KDIAG,ICORFL,IXDR
4371 !el      COMMON /MACHSW/ KDIAG,ICORFL,IXDR
4372       character(len=8),dimension(0:3) :: diagmeth = reshape((/'Library ',&
4373         'EVVRSP  ','Givens  ','Jacobi  '/),shape(diagmeth))
4374 !      character(len=80) :: ucase
4375       character(len=640) :: controlcard
4376
4377       real(kind=8) :: seed,rmsdbc,rmsdbc1max,rmsdbcm,drms,timem!,&
4378       integer i
4379
4380       nglob_csa=0
4381       eglob_csa=1d99
4382       nmin_csa=0
4383       read (INP,'(a)') titel
4384       call card_concat(controlcard,.true.)
4385 !      out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0
4386 !      print *,"Processor",me," fg_rank",fg_rank," out1file",out1file
4387       call reada(controlcard,'SEED',seed,0.0D0)
4388       call random_init(seed)
4389 ! Set up the time limit (caution! The time must be input in minutes!)
4390       read_cart=index(controlcard,'READ_CART').gt.0
4391       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
4392       call readi(controlcard,'SYM',symetr,1)
4393       call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours
4394       unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
4395       call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes
4396       call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
4397       call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
4398       call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
4399       call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
4400       call reada(controlcard,'DRMS',drms,0.1D0)
4401       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4402        write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
4403        write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
4404        write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
4405        write (iout,'(a,f10.1)')'DRMS    = ',drms
4406        write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
4407        write (iout,'(a,f10.1)') 'Time limit (min):',timlim
4408       endif
4409       call readi(controlcard,'NZ_START',nz_start,0)
4410       call readi(controlcard,'NZ_END',nz_end,0)
4411       call readi(controlcard,'IZ_SC',iz_sc,0)
4412       timlim=60.0D0*timlim
4413       safety = 60.0d0*safety
4414       timem=timlim
4415       modecalc=0
4416       call reada(controlcard,"T_BATH",t_bath,300.0d0)
4417 !C SHIELD keyword sets if the shielding effect of side-chains is used
4418 !C 0 denots no shielding is used all peptide are equally despite the
4419 !C solvent accesible area
4420 !C 1 the newly introduced function
4421 !C 2 reseved for further possible developement
4422       call readi(controlcard,'SHIELD',shield_mode,0)
4423 !C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4424         write(iout,*) "shield_mode",shield_mode
4425       call readi(controlcard,'TORMODE',tor_mode,0)
4426 !C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
4427         write(iout,*) "torsional and valence angle mode",tor_mode
4428
4429 !C  Varibles set size of box
4430       with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
4431       protein=index(controlcard,"PROTEIN").gt.0
4432       ions=index(controlcard,"IONS").gt.0
4433       call readi(controlcard,'OLDION',oldion,1)
4434       nucleic=index(controlcard,"NUCLEIC").gt.0
4435       write (iout,*) "with_theta_constr ",with_theta_constr
4436       AFMlog=(index(controlcard,'AFM'))
4437       selfguide=(index(controlcard,'SELFGUIDE'))
4438       print *,'AFMlog',AFMlog,selfguide,"KUPA"
4439       call readi(controlcard,'GENCONSTR',genconstr,0)
4440       call reada(controlcard,'BOXX',boxxsize,100.0d0)
4441       call reada(controlcard,'BOXY',boxysize,100.0d0)
4442       call reada(controlcard,'BOXZ',boxzsize,100.0d0)
4443       call readi(controlcard,'TUBEMOD',tubemode,0)
4444       print *,"SCELE",scelemode
4445       call readi(controlcard,"SCELEMODE",scelemode,0)
4446       print *,"SCELE",scelemode
4447
4448 ! elemode = 0 is orignal UNRES electrostatics
4449 ! elemode = 1 is "Momo" potentials in progress
4450 ! elemode = 2 is in development EVALD
4451
4452
4453       write (iout,*) TUBEmode,"TUBEMODE"
4454       if (TUBEmode.gt.0) then
4455        call reada(controlcard,"XTUBE",tubecenter(1),0.0d0)
4456        call reada(controlcard,"YTUBE",tubecenter(2),0.0d0)
4457        call reada(controlcard,"ZTUBE",tubecenter(3),0.0d0)
4458        call reada(controlcard,"RTUBE",tubeR0,0.0d0)
4459        call reada(controlcard,"TUBETOP",bordtubetop,boxzsize)
4460        call reada(controlcard,"TUBEBOT",bordtubebot,0.0d0)
4461        call reada(controlcard,"TUBEBUF",tubebufthick,1.0d0)
4462        buftubebot=bordtubebot+tubebufthick
4463        buftubetop=bordtubetop-tubebufthick
4464       endif
4465
4466 ! CUTOFFF ON ELECTROSTATICS
4467       call reada(controlcard,"R_CUT_ELE",r_cut_ele,25.0d0)
4468       call reada(controlcard,"LAMBDA_ELE",rlamb_ele,0.3d0)
4469       write(iout,*) "R_CUT_ELE=",r_cut_ele
4470 ! Lipidic parameters
4471       call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
4472       call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
4473       if (lipthick.gt.0.0d0) then
4474        bordliptop=(boxzsize+lipthick)/2.0
4475        bordlipbot=bordliptop-lipthick
4476       if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0)) &
4477       write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
4478       buflipbot=bordlipbot+lipbufthick
4479       bufliptop=bordliptop-lipbufthick
4480       if ((lipbufthick*2.0d0).gt.lipthick) &
4481        write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
4482       endif !lipthick.gt.0
4483       write(iout,*) "bordliptop=",bordliptop
4484       write(iout,*) "bordlipbot=",bordlipbot
4485       write(iout,*) "bufliptop=",bufliptop
4486       write(iout,*) "buflipbot=",buflipbot
4487       write (iout,*) "SHIELD MODE",shield_mode
4488
4489 !C-------------------------
4490       minim=(index(controlcard,'MINIMIZE').gt.0)
4491       dccart=(index(controlcard,'CART').gt.0)
4492       overlapsc=(index(controlcard,'OVERLAP').gt.0)
4493       overlapsc=.not.overlapsc
4494       searchsc=(index(controlcard,'NOSEARCHSC').gt.0)
4495       searchsc=.not.searchsc
4496       sideadd=(index(controlcard,'SIDEADD').gt.0)
4497       energy_dec=(index(controlcard,'ENERGY_DEC').gt.0)
4498       outpdb=(index(controlcard,'PDBOUT').gt.0)
4499       outmol2=(index(controlcard,'MOL2OUT').gt.0)
4500       pdbref=(index(controlcard,'PDBREF').gt.0)
4501       refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
4502       indpdb=index(controlcard,'PDBSTART')
4503       extconf=(index(controlcard,'EXTCONF').gt.0)
4504       call readi(controlcard,'IPRINT',iprint,0)
4505       call readi(controlcard,'MAXGEN',maxgen,10000)
4506       call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
4507       call readi(controlcard,"KDIAG",kdiag,0)
4508       call readi(controlcard,"RESCALE_MODE",rescale_mode,2)
4509       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) &
4510        write (iout,*) "RESCALE_MODE",rescale_mode
4511       split_ene=index(controlcard,'SPLIT_ENE').gt.0
4512       if (index(controlcard,'REGULAR').gt.0.0D0) then
4513         call reada(controlcard,'WEIDIS',weidis,0.1D0)
4514         modecalc=1
4515         refstr=.true.
4516       endif
4517       if (index(controlcard,'CHECKGRAD').gt.0) then
4518         modecalc=5
4519         if (index(controlcard,'CART').gt.0) then
4520           icheckgrad=1
4521         elseif (index(controlcard,'CARINT').gt.0) then
4522           icheckgrad=2
4523         else
4524           icheckgrad=3
4525         endif
4526       elseif (index(controlcard,'THREAD').gt.0) then
4527         modecalc=2
4528         call readi(controlcard,'THREAD',nthread,0)
4529         if (nthread.gt.0) then
4530           call reada(controlcard,'WEIDIS',weidis,0.1D0)
4531         else
4532           if (fg_rank.eq.0) &
4533           write (iout,'(a)')'A number has to follow the THREAD keyword.'
4534           stop 'Error termination in Read_Control.'
4535         endif
4536       else if (index(controlcard,'MCMA').gt.0) then
4537         modecalc=3
4538       else if (index(controlcard,'MCEE').gt.0) then
4539         modecalc=6
4540       else if (index(controlcard,'MULTCONF').gt.0) then
4541         modecalc=4
4542       else if (index(controlcard,'MAP').gt.0) then
4543         modecalc=7
4544         call readi(controlcard,'MAP',nmap,0)
4545       else if (index(controlcard,'CSA').gt.0) then
4546         modecalc=8
4547 !rc      else if (index(controlcard,'ZSCORE').gt.0) then
4548 !rc
4549 !rc  ZSCORE is rm from UNRES, modecalc=9 is available
4550 !rc
4551 !rc        modecalc=9
4552 !fcm      else if (index(controlcard,'MCMF').gt.0) then
4553 !fmc        modecalc=10
4554       else if (index(controlcard,'SOFTREG').gt.0) then
4555         modecalc=11
4556       else if (index(controlcard,'CHECK_BOND').gt.0) then
4557         modecalc=-1
4558       else if (index(controlcard,'TEST').gt.0) then
4559         modecalc=-2
4560       else if (index(controlcard,'MD').gt.0) then
4561         modecalc=12
4562       else if (index(controlcard,'RE ').gt.0) then
4563         modecalc=14
4564       endif
4565
4566       lmuca=index(controlcard,'MUCA').gt.0
4567       call readi(controlcard,'MUCADYN',mucadyn,0)
4568       call readi(controlcard,'MUCASMOOTH',muca_smooth,0)
4569       if (lmuca .and. (me.eq.king .or. .not.out1file )) &
4570        then
4571        write (iout,*) 'MUCADYN=',mucadyn
4572        write (iout,*) 'MUCASMOOTH=',muca_smooth
4573       endif
4574
4575       iscode=index(controlcard,'ONE_LETTER')
4576       indphi=index(controlcard,'PHI')
4577       indback=index(controlcard,'BACK')
4578       iranconf=index(controlcard,'RAND_CONF')
4579       i2ndstr=index(controlcard,'USE_SEC_PRED')
4580       gradout=index(controlcard,'GRADOUT').gt.0
4581       gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
4582       call reada(controlcard,'DISTCHAINMAX',distchainmax,5.0d0)
4583       if (me.eq.king .or. .not.out1file ) &
4584         write (iout,*) "DISTCHAINMAX",distchainmax
4585
4586       if(me.eq.king.or..not.out1file) &
4587        write (iout,'(2a)') diagmeth(kdiag),&
4588         ' routine used to diagonalize matrices.'
4589       if (shield_mode.gt.0) then
4590        pi=4.0D0*datan(1.0D0)
4591 !C VSolvSphere the volume of solving sphere
4592       print *,pi,"pi"
4593 !C rpp(1,1) is the energy r0 for peptide group contact and will be used for it
4594 !C there will be no distinction between proline peptide group and normal peptide
4595 !C group in case of shielding parameters
4596       VSolvSphere=4.0/3.0*pi*(4.50d0)**3
4597       VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(4.50/2.0)**3
4598       write (iout,*) VSolvSphere,VSolvSphere_div
4599 !C long axis of side chain
4600 !      do i=1,ntyp
4601 !      long_r_sidechain(i)=vbldsc0(1,i)
4602 !      short_r_sidechain(i)=sigma0(i)
4603 !      write(iout,*) "parame for long and short axis",i,vbldsc0(1,i),&
4604 !         sigma0(i)
4605 !      enddo
4606       buff_shield=1.0d0
4607       endif
4608       itime_mat=0
4609       return
4610       end subroutine read_control
4611 !-----------------------------------------------------------------------------
4612       subroutine read_REMDpar
4613 !
4614 ! Read REMD settings
4615 !
4616 !       use control
4617 !       use energy
4618 !       use geometry
4619       use REMD_data
4620       use MPI_data
4621       use control_data, only:out1file
4622 !      implicit real*8 (a-h,o-z)
4623 !      include 'DIMENSIONS'
4624 !      include 'COMMON.IOUNITS'
4625 !      include 'COMMON.TIME1'
4626 !      include 'COMMON.MD'
4627       use MD_data
4628 !el #ifndef LANG0
4629 !el      include 'COMMON.LANGEVIN'
4630 !el #else
4631 !el      include 'COMMON.LANGEVIN.lang0'
4632 !el #endif
4633 !      include 'COMMON.INTERACT'
4634 !      include 'COMMON.NAMES'
4635 !      include 'COMMON.GEO'
4636 !      include 'COMMON.REMD'
4637 !      include 'COMMON.CONTROL'
4638 !      include 'COMMON.SETUP'
4639 !      character(len=80) :: ucase
4640       character(len=320) :: controlcard
4641       character(len=3200) :: controlcard1
4642       integer :: iremd_m_total
4643 !el local variables
4644       integer :: i
4645 !     real(kind=8) :: var,ene
4646
4647       if(me.eq.king.or..not.out1file) &
4648        write (iout,*) "REMD setup"
4649
4650       call card_concat(controlcard,.true.)
4651       call readi(controlcard,"NREP",nrep,3)
4652       call readi(controlcard,"NSTEX",nstex,1000)
4653       call reada(controlcard,"RETMIN",retmin,10.0d0)
4654       call reada(controlcard,"RETMAX",retmax,1000.0d0)
4655       mremdsync=(index(controlcard,'SYNC').gt.0)
4656       call readi(controlcard,"NSYN",i_sync_step,100)
4657       restart1file=(index(controlcard,'REST1FILE').gt.0)
4658       traj1file=(index(controlcard,'TRAJ1FILE').gt.0)
4659       call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1)
4660       if(max_cache_traj_use.gt.max_cache_traj) &
4661                 max_cache_traj_use=max_cache_traj
4662       if(me.eq.king.or..not.out1file) then
4663 !d       if (traj1file) then
4664 !rc caching is in testing - NTWX is not ignored
4665 !d        write (iout,*) "NTWX value is ignored"
4666 !d        write (iout,*) "  trajectory is stored to one file by master"
4667 !d        write (iout,*) "  before exchange at NSTEX intervals"
4668 !d       endif
4669        write (iout,*) "NREP= ",nrep
4670        write (iout,*) "NSTEX= ",nstex
4671        write (iout,*) "SYNC= ",mremdsync
4672        write (iout,*) "NSYN= ",i_sync_step
4673        write (iout,*) "TRAJCACHE= ",max_cache_traj_use
4674       endif
4675       remd_tlist=.false.
4676       allocate(remd_t(nrep),remd_m(nrep)) !(maxprocs)
4677       if (index(controlcard,'TLIST').gt.0) then
4678          remd_tlist=.true.
4679          call card_concat(controlcard1,.true.)
4680          read(controlcard1,*) (remd_t(i),i=1,nrep)
4681          if(me.eq.king.or..not.out1file) &
4682           write (iout,*)'tlist',(remd_t(i),i=1,nrep)
4683       endif
4684       remd_mlist=.false.
4685       if (index(controlcard,'MLIST').gt.0) then
4686          remd_mlist=.true.
4687          call card_concat(controlcard1,.true.)
4688          read(controlcard1,*) (remd_m(i),i=1,nrep)
4689          if(me.eq.king.or..not.out1file) then
4690           write (iout,*)'mlist',(remd_m(i),i=1,nrep)
4691           iremd_m_total=0
4692           do i=1,nrep
4693            iremd_m_total=iremd_m_total+remd_m(i)
4694           enddo
4695           write (iout,*) 'Total number of replicas ',iremd_m_total
4696          endif
4697       endif
4698       if(me.eq.king.or..not.out1file) &
4699        write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
4700       return
4701       end subroutine read_REMDpar
4702 !-----------------------------------------------------------------------------
4703       subroutine read_MDpar
4704 !
4705 ! Read MD settings
4706 !
4707       use control_data, only: r_cut,rlamb,out1file
4708       use energy_data
4709       use geometry_data, only: pi
4710       use MPI_data
4711 !      implicit real*8 (a-h,o-z)
4712 !      include 'DIMENSIONS'
4713 !      include 'COMMON.IOUNITS'
4714 !      include 'COMMON.TIME1'
4715 !      include 'COMMON.MD'
4716       use MD_data
4717 !el #ifndef LANG0
4718 !el      include 'COMMON.LANGEVIN'
4719 !el #else
4720 !el      include 'COMMON.LANGEVIN.lang0'
4721 !el #endif
4722 !      include 'COMMON.INTERACT'
4723 !      include 'COMMON.NAMES'
4724 !      include 'COMMON.GEO'
4725 !      include 'COMMON.SETUP'
4726 !      include 'COMMON.CONTROL'
4727 !      include 'COMMON.SPLITELE'
4728 !      character(len=80) :: ucase
4729       character(len=320) :: controlcard
4730 !el local variables
4731       integer :: i,j
4732       real(kind=8) :: eta
4733
4734       call card_concat(controlcard,.true.)
4735       call readi(controlcard,"NSTEP",n_timestep,1000000)
4736       call readi(controlcard,"NTWE",ntwe,100)
4737       call readi(controlcard,"NTWX",ntwx,1000)
4738       call reada(controlcard,"DT",d_time,1.0d-1)
4739       call reada(controlcard,"DVMAX",dvmax,2.0d1)
4740       call reada(controlcard,"DAMAX",damax,1.0d1)
4741       call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1)
4742       call readi(controlcard,"LANG",lang,0)
4743       RESPA = index(controlcard,"RESPA") .gt. 0
4744       call readi(controlcard,"NTIME_SPLIT",ntime_split,1)
4745       ntime_split0=ntime_split
4746       call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64)
4747       ntime_split0=ntime_split
4748       call reada(controlcard,"R_CUT",r_cut,2.0d0)
4749       call reada(controlcard,"LAMBDA",rlamb,0.3d0)
4750       rest = index(controlcard,"REST").gt.0
4751       tbf = index(controlcard,"TBF").gt.0
4752       usampl = index(controlcard,"USAMPL").gt.0
4753       mdpdb = index(controlcard,"MDPDB").gt.0
4754       call reada(controlcard,"T_BATH",t_bath,300.0d0)
4755       call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1)
4756       call reada(controlcard,"EQ_TIME",eq_time,1.0d+4)
4757       call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000)
4758       if (count_reset_moment.eq.0) count_reset_moment=1000000000
4759       call readi(controlcard,"RESET_VEL",count_reset_vel,1000)
4760       reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0
4761       reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0
4762       if (count_reset_vel.eq.0) count_reset_vel=1000000000
4763       large = index(controlcard,"LARGE").gt.0
4764       print_compon = index(controlcard,"PRINT_COMPON").gt.0
4765       rattle = index(controlcard,"RATTLE").gt.0
4766       preminim=(index(controlcard,'PREMINIM').gt.0)
4767       write (iout,*) "PREMINIM ",preminim
4768       dccart=(index(controlcard,'CART').gt.0)
4769       if (preminim) call read_minim
4770 !  if performing umbrella sampling, fragments constrained are read from the fragment file
4771       nset=0
4772       if(usampl) then
4773         call read_fragments
4774       endif
4775
4776       if(me.eq.king.or..not.out1file) then
4777        write (iout,*)
4778        write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run "
4779        write (iout,*)
4780        write (iout,'(a)') "The units are:"
4781        write (iout,'(a)') "positions: angstrom, time: 48.9 fs"
4782        write (iout,'(2a)') "velocity: angstrom/(48.9 fs),",&
4783         " acceleration: angstrom/(48.9 fs)**2"
4784        write (iout,'(a)') "energy: kcal/mol, temperature: K"
4785        write (iout,*)
4786        write (iout,'(a60,i10)') "Number of time steps:",n_timestep
4787        write (iout,'(a60,f10.5,a)') &
4788         "Initial time step of numerical integration:",d_time,&
4789         " natural units"
4790        write (iout,'(60x,f10.5,a)') d_time*48.9," fs"
4791        if (RESPA) then
4792         write (iout,'(2a,i4,a)') &
4793           "A-MTS algorithm used; initial time step for fast-varying",&
4794           " short-range forces split into",ntime_split," steps."
4795         write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff",&
4796          r_cut," lambda",rlamb
4797        endif
4798        write (iout,'(2a,f10.5)') &
4799         "Maximum acceleration threshold to reduce the time step",&
4800         "/increase split number:",damax
4801        write (iout,'(2a,f10.5)') &
4802         "Maximum predicted energy drift to reduce the timestep",&
4803         "/increase split number:",edriftmax
4804        write (iout,'(a60,f10.5)') &
4805        "Maximum velocity threshold to reduce velocities:",dvmax
4806        write (iout,'(a60,i10)') "Frequency of property output:",ntwe
4807        write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx
4808        if (rattle) write (iout,'(a60)') &
4809         "Rattle algorithm used to constrain the virtual bonds"
4810       endif
4811       reset_fricmat=1000
4812       if (lang.gt.0) then
4813         call reada(controlcard,"ETAWAT",etawat,0.8904d0)
4814         call reada(controlcard,"RWAT",rwat,1.4d0)
4815         call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2)
4816         surfarea=index(controlcard,"SURFAREA").gt.0
4817         call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000)
4818         if(me.eq.king.or..not.out1file)then
4819          write (iout,'(/a,$)') "Langevin dynamics calculation"
4820          if (lang.eq.1) then
4821           write (iout,'(a/)') &
4822             " with direct integration of Langevin equations"
4823          else if (lang.eq.2) then
4824           write (iout,'(a/)') " with TINKER stochasic MD integrator"
4825          else if (lang.eq.3) then
4826           write (iout,'(a/)') " with Ciccotti's stochasic MD integrator"
4827          else if (lang.eq.4) then
4828           write (iout,'(a/)') " in overdamped mode"
4829          else
4830           write (iout,'(//a,i5)') &
4831             "=========== ERROR: Unknown Langevin dynamics mode:",lang
4832           stop
4833          endif
4834          write (iout,'(a60,f10.5)') "Temperature:",t_bath
4835          write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat
4836          write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat
4837          write (iout,'(a60,f10.5)') &
4838          "Scaling factor of the friction forces:",scal_fric
4839          if (surfarea) write (iout,'(2a,i10,a)') &
4840            "Friction coefficients will be scaled by solvent-accessible",&
4841            " surface area every",reset_fricmat," steps."
4842         endif
4843 ! Calculate friction coefficients and bounds of stochastic forces
4844         eta=6*pi*cPoise*etawat
4845         if(me.eq.king.or..not.out1file) &
4846          write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:",&
4847           eta
4848 !        allocate(gamp
4849         do j=1,5 !types of molecules
4850         gamp(j)=scal_fric*(pstok(j)+rwat)*eta
4851         stdfp(j)=dsqrt(2*Rb*t_bath/d_time)
4852         enddo
4853         allocate(gamsc(ntyp1,5),stdfsc(ntyp1,5)) !(ntyp1)
4854         do j=1,5 !types of molecules
4855         do i=1,ntyp
4856           gamsc(i,j)=scal_fric*(restok(i,j)+rwat)*eta
4857           stdfsc(i,j)=dsqrt(2*Rb*t_bath/d_time)
4858         enddo
4859         enddo
4860
4861         if(me.eq.king.or..not.out1file)then
4862          write (iout,'(/2a/)') &
4863          "Radii of site types and friction coefficients and std's of",&
4864          " stochastic forces of fully exposed sites"
4865          write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp(1),stdfp*dsqrt(gamp(1))
4866          do i=1,ntyp
4867           write (iout,'(a5,f5.2,2f10.5)') restyp(i,1),restok(i,1),&
4868            gamsc(i,1),stdfsc(i,1)*dsqrt(gamsc(i,1))
4869          enddo
4870         endif
4871       else if (tbf) then
4872         if(me.eq.king.or..not.out1file)then
4873          write (iout,'(a)') "Berendsen bath calculation"
4874          write (iout,'(a60,f10.5)') "Temperature:",t_bath
4875          write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath
4876          if (reset_moment) &
4877          write (iout,'(a,i10,a)') "Momenta will be reset at zero every",&
4878          count_reset_moment," steps"
4879          if (reset_vel) &
4880           write (iout,'(a,i10,a)') &
4881           "Velocities will be reset at random every",count_reset_vel,&
4882          " steps"
4883         endif
4884       else
4885         if(me.eq.king.or..not.out1file) &
4886          write (iout,'(a31)') "Microcanonical mode calculation"
4887       endif
4888       if(me.eq.king.or..not.out1file)then
4889        if (rest) write (iout,'(/a/)') "===== Calculation restarted ===="
4890        if (usampl) then
4891           write(iout,*) "MD running with constraints."
4892           write(iout,*) "Equilibration time ", eq_time, " mtus."
4893           write(iout,*) "Constraining ", nfrag," fragments."
4894           write(iout,*) "Length of each fragment, weight and q0:"
4895           do iset=1,nset
4896            write (iout,*) "Set of restraints #",iset
4897            do i=1,nfrag
4898               write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset),&
4899                  ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset)
4900            enddo
4901            write(iout,*) "constraints between ", npair, "fragments."
4902            write(iout,*) "constraint pairs, weights and q0:"
4903            do i=1,npair
4904             write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset),&
4905                    ipair(2,i,iset),wpair(i,iset),qinpair(i,iset)
4906            enddo
4907            write(iout,*) "angle constraints within ", nfrag_back,&
4908             "backbone fragments."
4909            write(iout,*) "fragment, weights:"
4910            do i=1,nfrag_back
4911             write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset),&
4912                ifrag_back(2,i,iset),wfrag_back(1,i,iset),&
4913                wfrag_back(2,i,iset),wfrag_back(3,i,iset)
4914            enddo
4915           enddo
4916         iset=mod(kolor,nset)+1
4917        endif
4918       endif
4919       if(me.eq.king.or..not.out1file) &
4920        write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup "
4921       return
4922       end subroutine read_MDpar
4923 !-----------------------------------------------------------------------------
4924       subroutine map_read
4925
4926       use map_data
4927 !      implicit real*8 (a-h,o-z)
4928 !      include 'DIMENSIONS'
4929 !      include 'COMMON.MAP'
4930 !      include 'COMMON.IOUNITS'
4931       character(len=3) :: angid(4) = (/'THE','PHI','ALP','OME'/)
4932       character(len=80) :: mapcard      !,ucase
4933 !el local variables
4934       integer :: imap
4935 !     real(kind=8) :: var,ene
4936
4937       do imap=1,nmap
4938         read (inp,'(a)') mapcard
4939         mapcard=ucase(mapcard)
4940         if (index(mapcard,'PHI').gt.0) then
4941           kang(imap)=1
4942         else if (index(mapcard,'THE').gt.0) then
4943           kang(imap)=2
4944         else if (index(mapcard,'ALP').gt.0) then
4945           kang(imap)=3
4946         else if (index(mapcard,'OME').gt.0) then
4947           kang(imap)=4
4948         else
4949           write(iout,'(a)')'Error - illegal variable spec in MAP card.'
4950           stop 'Error - illegal variable spec in MAP card.'
4951         endif
4952         call readi (mapcard,'RES1',res1(imap),0)
4953         call readi (mapcard,'RES2',res2(imap),0)
4954         if (res1(imap).eq.0) then
4955           res1(imap)=res2(imap)
4956         else if (res2(imap).eq.0) then
4957           res2(imap)=res1(imap)
4958         endif
4959         if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then
4960           write (iout,'(a)') &
4961           'Error - illegal definition of variable group in MAP.'
4962           stop 'Error - illegal definition of variable group in MAP.'
4963         endif
4964         call reada(mapcard,'FROM',ang_from(imap),0.0D0)
4965         call reada(mapcard,'TO',ang_to(imap),0.0D0)
4966         call readi(mapcard,'NSTEP',nstep(imap),0)
4967         if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then
4968           write (iout,'(a)') &
4969            'Illegal boundary and/or step size specification in MAP.'
4970           stop 'Illegal boundary and/or step size specification in MAP.'
4971         endif
4972       enddo ! imap
4973       return
4974       end subroutine map_read
4975 !-----------------------------------------------------------------------------
4976       subroutine csaread
4977
4978       use control_data, only: vdisulf
4979       use csa_data
4980 !      implicit real*8 (a-h,o-z)
4981 !      include 'DIMENSIONS'
4982 !      include 'COMMON.IOUNITS'
4983 !      include 'COMMON.GEO'
4984 !      include 'COMMON.CSA'
4985 !      include 'COMMON.BANK'
4986 !      include 'COMMON.CONTROL'
4987 !      character(len=80) :: ucase
4988       character(len=620) :: mcmcard
4989 !el local variables
4990 !     integer :: ntf,ik,iw_pdb
4991 !     real(kind=8) :: var,ene
4992
4993       call card_concat(mcmcard,.true.)
4994
4995       call readi(mcmcard,'NCONF',nconf,50)
4996       call readi(mcmcard,'NADD',nadd,0)
4997       call readi(mcmcard,'JSTART',jstart,1)
4998       call readi(mcmcard,'JEND',jend,1)
4999       call readi(mcmcard,'NSTMAX',nstmax,500000)
5000       call readi(mcmcard,'N0',n0,1)
5001       call readi(mcmcard,'N1',n1,6)
5002       call readi(mcmcard,'N2',n2,4)
5003       call readi(mcmcard,'N3',n3,0)
5004       call readi(mcmcard,'N4',n4,0)
5005       call readi(mcmcard,'N5',n5,0)
5006       call readi(mcmcard,'N6',n6,10)
5007       call readi(mcmcard,'N7',n7,0)
5008       call readi(mcmcard,'N8',n8,0)
5009       call readi(mcmcard,'N9',n9,0)
5010       call readi(mcmcard,'N14',n14,0)
5011       call readi(mcmcard,'N15',n15,0)
5012       call readi(mcmcard,'N16',n16,0)
5013       call readi(mcmcard,'N17',n17,0)
5014       call readi(mcmcard,'N18',n18,0)
5015
5016       vdisulf=(index(mcmcard,'DYNSS').gt.0)
5017
5018       call readi(mcmcard,'NDIFF',ndiff,2)
5019       call reada(mcmcard,'DIFFCUT',diffcut,0.0d0)
5020       call readi(mcmcard,'IS1',is1,1)
5021       call readi(mcmcard,'IS2',is2,8)
5022       call readi(mcmcard,'NRAN0',nran0,4)
5023       call readi(mcmcard,'NRAN1',nran1,2)
5024       call readi(mcmcard,'IRR',irr,1)
5025       call readi(mcmcard,'NSEED',nseed,20)
5026       call readi(mcmcard,'NTOTAL',ntotal,10000)
5027       call reada(mcmcard,'CUT1',cut1,2.0d0)
5028       call reada(mcmcard,'CUT2',cut2,5.0d0)
5029       call reada(mcmcard,'ESTOP',estop,-3000.0d0)
5030       call readi(mcmcard,'ICMAX',icmax,3)
5031       call readi(mcmcard,'IRESTART',irestart,0)
5032 !!bankt      call readi(mcmcard,'NBANKTM',ntbankm,0)
5033       ntbankm=0
5034 !!bankt
5035       call reada(mcmcard,'DELE',dele,20.0d0)
5036       call reada(mcmcard,'DIFCUT',difcut,720.0d0)
5037       call readi(mcmcard,'IREF',iref,0)
5038       call reada(mcmcard,'RMSCUT',rmscut,4.0d0)
5039       call reada(mcmcard,'PNCCUT',pnccut,0.5d0)
5040       call readi(mcmcard,'NCONF_IN',nconf_in,0)
5041       call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0)
5042       write (iout,*) "NCONF_IN",nconf_in
5043       return
5044       end subroutine csaread
5045 !-----------------------------------------------------------------------------
5046       subroutine mcmread
5047
5048       use mcm_data
5049       use control_data, only: MaxMoveType
5050       use MD_data
5051       use minim_data
5052 !      implicit real*8 (a-h,o-z)
5053 !      include 'DIMENSIONS'
5054 !      include 'COMMON.MCM'
5055 !      include 'COMMON.MCE'
5056 !      include 'COMMON.IOUNITS'
5057 !      character(len=80) :: ucase
5058       character(len=320) :: mcmcard
5059 !el local variables
5060       integer :: i
5061 !     real(kind=8) :: var,ene
5062
5063       call card_concat(mcmcard,.true.)
5064       call readi(mcmcard,'MAXACC',maxacc,100)
5065       call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000)
5066       call readi(mcmcard,'MAXTRIAL',maxtrial,100)
5067       call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000)
5068       call readi(mcmcard,'MAXREPM',maxrepm,200)
5069       call reada(mcmcard,'RANFRACT',RanFract,0.5D0)
5070       call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0)
5071       call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3)
5072       call reada(mcmcard,'E_UP',e_up,5.0D0)
5073       call reada(mcmcard,'DELTE',delte,0.1D0)
5074       call readi(mcmcard,'NSWEEP',nsweep,5)
5075       call readi(mcmcard,'NSTEPH',nsteph,0)
5076       call readi(mcmcard,'NSTEPC',nstepc,0)
5077       call reada(mcmcard,'TMIN',tmin,298.0D0)
5078       call reada(mcmcard,'TMAX',tmax,298.0D0)
5079       call readi(mcmcard,'NWINDOW',nwindow,0)
5080       call readi(mcmcard,'PRINT_MC',print_mc,0)
5081       print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0)
5082       print_int=(index(mcmcard,'NO_PRINT_INT').le.0)
5083       ent_read=(index(mcmcard,'ENT_READ').gt.0)
5084       call readi(mcmcard,'SAVE_FREQ',save_frequency,1000)
5085       call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000)
5086       call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000)
5087       call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000)
5088       call readi(mcmcard,'PRINT_FREQ',print_freq,1000)
5089       if (nwindow.gt.0) then
5090         allocate(winstart(nwindow))     !!el (maxres)
5091         allocate(winend(nwindow))       !!el
5092         allocate(winlen(nwindow))       !!el
5093         read (inp,*) (winstart(i),winend(i),i=1,nwindow)
5094         do i=1,nwindow
5095           winlen(i)=winend(i)-winstart(i)+1
5096         enddo
5097       endif
5098       if (tmax.lt.tmin) tmax=tmin
5099       if (tmax.eq.tmin) then
5100         nstepc=0
5101         nsteph=0
5102       endif
5103       if (nstepc.gt.0 .and. nsteph.gt.0) then
5104         tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0))
5105         tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0))
5106       endif
5107       allocate(sumpro_type(0:MaxMoveType)) !(0:MaxMoveType)
5108 ! Probabilities of different move types
5109       sumpro_type(0)=0.0D0
5110       call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0)
5111       call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0)
5112       sumpro_type(2)=sumpro_type(1)+sumpro_type(2)
5113       call reada(mcmcard,'THETA'     ,sumpro_type(3),0.0d0)
5114       sumpro_type(3)=sumpro_type(2)+sumpro_type(3)
5115       call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0)
5116       sumpro_type(4)=sumpro_type(3)+sumpro_type(4)
5117       do i=1,MaxMoveType
5118         print *,'i',i,' sumprotype',sumpro_type(i)
5119         sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType)
5120         print *,'i',i,' sumprotype',sumpro_type(i)
5121       enddo
5122       return
5123       end subroutine mcmread
5124 !-----------------------------------------------------------------------------
5125       subroutine read_minim
5126
5127       use minim_data
5128 !      implicit real*8 (a-h,o-z)
5129 !      include 'DIMENSIONS'
5130 !      include 'COMMON.MINIM'
5131 !      include 'COMMON.IOUNITS'
5132 !      character(len=80) :: ucase
5133       character(len=320) :: minimcard
5134 !el local variables
5135 !     integer :: ntf,ik,iw_pdb
5136 !     real(kind=8) :: var,ene
5137
5138       call card_concat(minimcard,.true.)
5139       call readi(minimcard,'MAXMIN',maxmin,2000)
5140       call readi(minimcard,'MAXFUN',maxfun,5000)
5141       call readi(minimcard,'MINMIN',minmin,maxmin)
5142       call readi(minimcard,'MINFUN',minfun,maxmin)
5143       call reada(minimcard,'TOLF',tolf,1.0D-2)
5144       call reada(minimcard,'RTOLF',rtolf,1.0D-4)
5145       print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1)
5146       print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1)
5147       print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1)
5148       write (iout,'(/80(1h*)/20x,a/80(1h*))') &
5149                'Options in energy minimization:'
5150       write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') &
5151        'MaxMin:',MaxMin,' MaxFun:',MaxFun,&
5152        'MinMin:',MinMin,' MinFun:',MinFun,&
5153        ' TolF:',TolF,' RTolF:',RTolF
5154       return
5155       end subroutine read_minim
5156 !-----------------------------------------------------------------------------
5157       subroutine openunits
5158
5159       use MD_data, only: usampl
5160       use csa_data
5161       use MPI_data
5162       use control_data, only:out1file
5163       use control, only: getenv_loc
5164 !      implicit real*8 (a-h,o-z)
5165 !      include 'DIMENSIONS'
5166 #ifdef MPI
5167       include 'mpif.h'
5168       character(len=16) :: form,nodename
5169       integer :: nodelen,ierror,npos
5170 #endif
5171 !      include 'COMMON.SETUP'
5172 !      include 'COMMON.IOUNITS'
5173 !      include 'COMMON.MD'
5174 !      include 'COMMON.CONTROL'
5175       integer :: lenpre,lenpot,lentmp   !,ilen
5176 !el      external ilen
5177       character(len=3) :: out1file_text !,ucase
5178       character(len=3) :: ll
5179 !el      external ucase
5180 !el local variables
5181 !     integer :: ntf,ik,iw_pdb
5182 !     real(kind=8) :: var,ene
5183 !
5184 !      print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits"
5185       call getenv_loc("PREFIX",prefix)
5186       pref_orig = prefix
5187       call getenv_loc("POT",pot)
5188       call getenv_loc("DIRTMP",tmpdir)
5189       call getenv_loc("CURDIR",curdir)
5190       call getenv_loc("OUT1FILE",out1file_text)
5191 !      print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV"
5192       out1file_text=ucase(out1file_text)
5193       if (out1file_text(1:1).eq."Y") then
5194         out1file=.true.
5195       else
5196         out1file=fg_rank.gt.0
5197       endif
5198       lenpre=ilen(prefix)
5199       lenpot=ilen(pot)
5200       lentmp=ilen(tmpdir)
5201       if (lentmp.gt.0) then
5202           write (*,'(80(1h!))')
5203           write (*,'(a,19x,a,19x,a)') "!","  A T T E N T I O N  ","!"
5204           write (*,'(80(1h!))')
5205           write (*,*)"All output files will be on node /tmp directory."
5206 #ifdef MPI
5207         call  MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR )
5208         if (me.eq.king) then
5209           write (*,*) "The master node is ",nodename
5210         else if (fg_rank.eq.0) then
5211           write (*,*) "I am the CG slave node ",nodename
5212         else
5213           write (*,*) "I am the FG slave node ",nodename
5214         endif
5215 #endif
5216         PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre)
5217         lenpre = lentmp+lenpre+1
5218       endif
5219       entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr'
5220 ! Get the names and open the input files
5221 #if defined(WINIFL) || defined(WINPGI)
5222       open(1,file=pref_orig(:ilen(pref_orig))// &
5223         '.inp',status='old',readonly,shared)
5224        open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5225 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5226 ! Get parameter filenames and open the parameter files.
5227       call getenv_loc('BONDPAR',bondname)
5228       open (ibond,file=bondname,status='old',readonly,shared)
5229       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5230       open (ibond_nucl,file=bondname_nucl,status='old',readonly,shared)
5231       call getenv_loc('THETPAR',thetname)
5232       open (ithep,file=thetname,status='old',readonly,shared)
5233       call getenv_loc('ROTPAR',rotname)
5234       open (irotam,file=rotname,status='old',readonly,shared)
5235       call getenv_loc('TORPAR',torname)
5236       open (itorp,file=torname,status='old',readonly,shared)
5237       call getenv_loc('TORDPAR',tordname)
5238       open (itordp,file=tordname,status='old',readonly,shared)
5239       call getenv_loc('FOURIER',fouriername)
5240       open (ifourier,file=fouriername,status='old',readonly,shared)
5241       call getenv_loc('ELEPAR',elename)
5242       open (ielep,file=elename,status='old',readonly,shared)
5243       call getenv_loc('SIDEPAR',sidename)
5244       open (isidep,file=sidename,status='old',readonly,shared)
5245
5246       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5247       open (ithep_nucl,file=thetname_nucl,status='old',readonly,shared)
5248       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5249       open (irotam_nucl,file=rotname_nucl,status='old',readonly,shared)
5250       call getenv_loc('TORPAR_NUCL',torname_nucl)
5251       open (itorp_nucl,file=torname_nucl,status='old',readonly,shared)
5252       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5253       open (itordp_nucl,file=tordname_nucl,status='old',readonly,shared)
5254       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5255       open (isidep_nucl,file=sidename_nucl,status='old',readonly,shared)
5256
5257
5258 #elif (defined CRAY) || (defined AIX)
5259       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
5260         action='read')
5261 !      print *,"Processor",myrank," opened file 1"
5262       open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5263 !      print *,"Processor",myrank," opened file 9"
5264 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5265 ! Get parameter filenames and open the parameter files.
5266       call getenv_loc('BONDPAR',bondname)
5267       open (ibond,file=bondname,status='old',action='read')
5268       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5269       open (ibond_nucl,file=bondname_nucl,status='old',action='read')
5270
5271 !      print *,"Processor",myrank," opened file IBOND"
5272       call getenv_loc('THETPAR',thetname)
5273       open (ithep,file=thetname,status='old',action='read')
5274 !      print *,"Processor",myrank," opened file ITHEP"
5275       call getenv_loc('ROTPAR',rotname)
5276       open (irotam,file=rotname,status='old',action='read')
5277 !      print *,"Processor",myrank," opened file IROTAM"
5278       call getenv_loc('TORPAR',torname)
5279       open (itorp,file=torname,status='old',action='read')
5280 !      print *,"Processor",myrank," opened file ITORP"
5281       call getenv_loc('TORDPAR',tordname)
5282       open (itordp,file=tordname,status='old',action='read')
5283 !      print *,"Processor",myrank," opened file ITORDP"
5284       call getenv_loc('SCCORPAR',sccorname)
5285       open (isccor,file=sccorname,status='old',action='read')
5286 !      print *,"Processor",myrank," opened file ISCCOR"
5287       call getenv_loc('FOURIER',fouriername)
5288       open (ifourier,file=fouriername,status='old',action='read')
5289 !      print *,"Processor",myrank," opened file IFOURIER"
5290       call getenv_loc('ELEPAR',elename)
5291       open (ielep,file=elename,status='old',action='read')
5292 !      print *,"Processor",myrank," opened file IELEP"
5293       call getenv_loc('SIDEPAR',sidename)
5294       open (isidep,file=sidename,status='old',action='read')
5295
5296       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5297       open (ithep_nucl,file=thetname_nucl,status='old',action='read')
5298       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5299       open (irotam_nucl,file=rotname_nucl,status='old',action='read')
5300       call getenv_loc('TORPAR_NUCL',torname_nucl)
5301       open (itorp_nucl,file=torname_nucl,status='old',action='read')
5302       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5303       open (itordp_nucl,file=tordname_nucl,status='old',action='read')
5304       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5305       open (isidep_nucl,file=sidename_nucl,status='old',action='read')
5306
5307       call getenv_loc('LIPTRANPAR',liptranname)
5308       open (iliptranpar,file=liptranname,status='old',action='read')
5309       call getenv_loc('TUBEPAR',tubename)
5310       open (itube,file=tubename,status='old',action='read')
5311       call getenv_loc('IONPAR',ionname)
5312       open (iion,file=ionname,status='old',action='read')
5313
5314 !      print *,"Processor",myrank," opened file ISIDEP"
5315 !      print *,"Processor",myrank," opened parameter files"
5316 #elif (defined G77)
5317       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old')
5318       open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5319 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5320 ! Get parameter filenames and open the parameter files.
5321       call getenv_loc('BONDPAR',bondname)
5322       open (ibond,file=bondname,status='old')
5323       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5324       open (ibond_nucl,file=bondname_nucl,status='old')
5325
5326       call getenv_loc('THETPAR',thetname)
5327       open (ithep,file=thetname,status='old')
5328       call getenv_loc('ROTPAR',rotname)
5329       open (irotam,file=rotname,status='old')
5330       call getenv_loc('TORPAR',torname)
5331       open (itorp,file=torname,status='old')
5332       call getenv_loc('TORDPAR',tordname)
5333       open (itordp,file=tordname,status='old')
5334       call getenv_loc('SCCORPAR',sccorname)
5335       open (isccor,file=sccorname,status='old')
5336       call getenv_loc('FOURIER',fouriername)
5337       open (ifourier,file=fouriername,status='old')
5338       call getenv_loc('ELEPAR',elename)
5339       open (ielep,file=elename,status='old')
5340       call getenv_loc('SIDEPAR',sidename)
5341       open (isidep,file=sidename,status='old')
5342
5343       open (ithep_nucl,file=thetname_nucl,status='old')
5344       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5345       open (irotam_nucl,file=rotname_nucl,status='old')
5346       call getenv_loc('TORPAR_NUCL',torname_nucl)
5347       open (itorp_nucl,file=torname_nucl,status='old')
5348       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5349       open (itordp_nucl,file=tordname_nucl,status='old')
5350       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5351       open (isidep_nucl,file=sidename_nucl,status='old')
5352
5353       call getenv_loc('LIPTRANPAR',liptranname)
5354       open (iliptranpar,file=liptranname,status='old')
5355       call getenv_loc('TUBEPAR',tubename)
5356       open (itube,file=tubename,status='old')
5357       call getenv_loc('IONPAR',ionname)
5358       open (iion,file=ionname,status='old')
5359       call getenv_loc('IONPAR_NUCL',ionnuclname)
5360       open (iionnucl,file=ionnuclname,status='old')
5361 #else
5362       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
5363         readonly)
5364        open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
5365 !      open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
5366 ! Get parameter filenames and open the parameter files.
5367       call getenv_loc('BONDPAR',bondname)
5368       open (ibond,file=bondname,status='old',action='read')
5369       call getenv_loc('BONDPAR_NUCL',bondname_nucl)
5370       open (ibond_nucl,file=bondname_nucl,status='old',action='read')
5371       call getenv_loc('THETPAR',thetname)
5372       open (ithep,file=thetname,status='old',action='read')
5373       call getenv_loc('ROTPAR',rotname)
5374       open (irotam,file=rotname,status='old',action='read')
5375       call getenv_loc('TORPAR',torname)
5376       open (itorp,file=torname,status='old',action='read')
5377       call getenv_loc('TORDPAR',tordname)
5378       open (itordp,file=tordname,status='old',action='read')
5379       call getenv_loc('SCCORPAR',sccorname)
5380       open (isccor,file=sccorname,status='old',action='read')
5381 #ifndef CRYST_THETA
5382       call getenv_loc('THETPARPDB',thetname_pdb)
5383       print *,"thetname_pdb ",thetname_pdb
5384       open (ithep_pdb,file=thetname_pdb,status='old',action='read')
5385       print *,ithep_pdb," opened"
5386 #endif
5387       call getenv_loc('FOURIER',fouriername)
5388       open (ifourier,file=fouriername,status='old',readonly)
5389       call getenv_loc('ELEPAR',elename)
5390       open (ielep,file=elename,status='old',readonly)
5391       call getenv_loc('SIDEPAR',sidename)
5392       open (isidep,file=sidename,status='old',readonly)
5393
5394       call getenv_loc('THETPAR_NUCL',thetname_nucl)
5395       open (ithep_nucl,file=thetname_nucl,status='old',action='read')
5396       call getenv_loc('ROTPAR_NUCL',rotname_nucl)
5397       open (irotam_nucl,file=rotname_nucl,status='old',action='read')
5398       call getenv_loc('TORPAR_NUCL',torname_nucl)
5399       open (itorp_nucl,file=torname_nucl,status='old',action='read')
5400       call getenv_loc('TORDPAR_NUCL',tordname_nucl)
5401       open (itordp_nucl,file=tordname_nucl,status='old',action='read')
5402       call getenv_loc('SIDEPAR_NUCL',sidename_nucl)
5403       open (isidep_nucl,file=sidename_nucl,status='old',action='read')
5404       call getenv_loc('SIDEPAR_SCBASE',sidename_scbase)
5405       open (isidep_scbase,file=sidename_scbase,status='old',action='read')
5406       call getenv_loc('PEPPAR_PEPBASE',pepname_pepbase)
5407       open (isidep_pepbase,file=pepname_pepbase,status='old',action='read')
5408       call getenv_loc('SCPAR_PHOSPH',pepname_scpho)
5409       open (isidep_scpho,file=pepname_scpho,status='old',action='read')
5410       call getenv_loc('PEPPAR_PHOSPH',pepname_peppho)
5411       open (isidep_peppho,file=pepname_peppho,status='old',action='read')
5412
5413
5414       call getenv_loc('LIPTRANPAR',liptranname)
5415       open (iliptranpar,file=liptranname,status='old',action='read')
5416       call getenv_loc('TUBEPAR',tubename)
5417       open (itube,file=tubename,status='old',action='read')
5418       call getenv_loc('IONPAR',ionname)
5419       open (iion,file=ionname,status='old',action='read')
5420       call getenv_loc('IONPAR_NUCL',ionnuclname)
5421       open (iionnucl,file=ionnuclname,status='old',action='read')
5422
5423 #ifndef CRYST_SC
5424       call getenv_loc('ROTPARPDB',rotname_pdb)
5425       open (irotam_pdb,file=rotname_pdb,status='old',action='read')
5426 #endif
5427 #endif
5428       call getenv_loc('SCPPAR_NUCL',scpname_nucl)
5429 #if defined(WINIFL) || defined(WINPGI)
5430       open (iscpp_nucl,file=scpname_nucl,status='old',readonly,shared)
5431 #elif (defined CRAY)  || (defined AIX)
5432       open (iscpp_nucl,file=scpname_nucl,status='old',action='read')
5433 #elif (defined G77)
5434       open (iscpp_nucl,file=scpname_nucl,status='old')
5435 #else
5436       open (iscpp_nucl,file=scpname_nucl,status='old',action='read')
5437 #endif
5438
5439 #ifndef OLDSCP
5440 !
5441 ! 8/9/01 In the newest version SCp interaction constants are read from a file
5442 ! Use -DOLDSCP to use hard-coded constants instead.
5443 !
5444       call getenv_loc('SCPPAR',scpname)
5445 #if defined(WINIFL) || defined(WINPGI)
5446       open (iscpp,file=scpname,status='old',readonly,shared)
5447 #elif (defined CRAY)  || (defined AIX)
5448       open (iscpp,file=scpname,status='old',action='read')
5449 #elif (defined G77)
5450       open (iscpp,file=scpname,status='old')
5451 #else
5452       open (iscpp,file=scpname,status='old',action='read')
5453 #endif
5454 #endif
5455       call getenv_loc('PATTERN',patname)
5456 #if defined(WINIFL) || defined(WINPGI)
5457       open (icbase,file=patname,status='old',readonly,shared)
5458 #elif (defined CRAY)  || (defined AIX)
5459       open (icbase,file=patname,status='old',action='read')
5460 #elif (defined G77)
5461       open (icbase,file=patname,status='old')
5462 #else
5463       open (icbase,file=patname,status='old',action='read')
5464 #endif
5465 #ifdef MPI
5466 ! Open output file only for CG processes
5467 !      print *,"Processor",myrank," fg_rank",fg_rank
5468       if (fg_rank.eq.0) then
5469
5470       if (nodes.eq.1) then
5471         npos=3
5472       else
5473         npos = dlog10(dfloat(nodes-1))+1
5474       endif
5475       if (npos.lt.3) npos=3
5476       write (liczba,'(i1)') npos
5477       form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) &
5478         //')'
5479       write (liczba,form) me
5480       outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// &
5481         liczba(:ilen(liczba))
5482       intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) &
5483         //'.int'
5484       pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) &
5485         //'.pdb'
5486       mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// &
5487         liczba(:ilen(liczba))//'.mol2'
5488       statname=prefix(:lenpre)//'_'//pot(:lenpot)// &
5489         liczba(:ilen(liczba))//'.stat'
5490       if (lentmp.gt.0) &
5491         call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) &
5492             //liczba(:ilen(liczba))//'.stat')
5493       rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) &
5494         //'.rst'
5495       if(usampl) then
5496           qname=prefix(:lenpre)//'_'//pot(:lenpot)// &
5497        liczba(:ilen(liczba))//'.const'
5498       endif
5499
5500       endif
5501 #else
5502       outname=prefix(:lenpre)//'.out_'//pot(:lenpot)
5503       intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int'
5504       pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb'
5505       mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2'
5506       statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat'
5507       if (lentmp.gt.0) &
5508         call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)// &
5509           '.stat')
5510       rest2name=prefix(:ilen(prefix))//'.rst'
5511       if(usampl) then
5512          qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const'
5513       endif
5514 #endif
5515 #if defined(AIX) || defined(PGI)
5516       if (me.eq.king .or. .not. out1file) &
5517          open(iout,file=outname,status='unknown')
5518 #ifdef DEBUG
5519       if (fg_rank.gt.0) then
5520         write (liczba,'(i3.3)') myrank/nfgtasks
5521         write (ll,'(bz,i3.3)') fg_rank
5522         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,&
5523          status='unknown')
5524       endif
5525 #endif
5526       if(me.eq.king) then
5527        open(igeom,file=intname,status='unknown',position='append')
5528        open(ipdb,file=pdbname,status='unknown')
5529        open(imol2,file=mol2name,status='unknown')
5530        open(istat,file=statname,status='unknown',position='append')
5531       else
5532 !1out       open(iout,file=outname,status='unknown')
5533       endif
5534 #else
5535       if (me.eq.king .or. .not.out1file) &
5536           open(iout,file=outname,status='unknown')
5537 #ifdef DEBUG
5538       if (fg_rank.gt.0) then
5539         write (liczba,'(i3.3)') myrank/nfgtasks
5540         write (ll,'(bz,i3.3)') fg_rank
5541         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,&
5542          status='unknown')
5543       endif
5544 #endif
5545       if(me.eq.king) then
5546        open(igeom,file=intname,status='unknown',access='append')
5547        open(ipdb,file=pdbname,status='unknown')
5548        open(imol2,file=mol2name,status='unknown')
5549        open(istat,file=statname,status='unknown',access='append')
5550       else
5551 !1out       open(iout,file=outname,status='unknown')
5552       endif
5553 #endif
5554       csa_rbank=prefix(:lenpre)//'.CSA.rbank'
5555       csa_seed=prefix(:lenpre)//'.CSA.seed'
5556       csa_history=prefix(:lenpre)//'.CSA.history'
5557       csa_bank=prefix(:lenpre)//'.CSA.bank'
5558       csa_bank1=prefix(:lenpre)//'.CSA.bank1'
5559       csa_alpha=prefix(:lenpre)//'.CSA.alpha'
5560       csa_alpha1=prefix(:lenpre)//'.CSA.alpha1'
5561 !!bankt      csa_bankt=prefix(:lenpre)//'.CSA.bankt'
5562       csa_int=prefix(:lenpre)//'.int'
5563       csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized'
5564       csa_native_int=prefix(:lenpre)//'.CSA.native.int'
5565       csa_in=prefix(:lenpre)//'.CSA.in'
5566 !      print *,"Processor",myrank,"fg_rank",fg_rank," opened files"
5567 ! Write file names
5568       if (me.eq.king)then
5569       write (iout,'(80(1h-))')
5570       write (iout,'(30x,a)') "FILE ASSIGNMENT"
5571       write (iout,'(80(1h-))')
5572       write (iout,*) "Input file                      : ",&
5573         pref_orig(:ilen(pref_orig))//'.inp'
5574       write (iout,*) "Output file                     : ",&
5575         outname(:ilen(outname))
5576       write (iout,*)
5577       write (iout,*) "Sidechain potential file        : ",&
5578         sidename(:ilen(sidename))
5579 #ifndef OLDSCP
5580       write (iout,*) "SCp potential file              : ",&
5581         scpname(:ilen(scpname))
5582 #endif
5583       write (iout,*) "Electrostatic potential file    : ",&
5584         elename(:ilen(elename))
5585       write (iout,*) "Cumulant coefficient file       : ",&
5586         fouriername(:ilen(fouriername))
5587       write (iout,*) "Torsional parameter file        : ",&
5588         torname(:ilen(torname))
5589       write (iout,*) "Double torsional parameter file : ",&
5590         tordname(:ilen(tordname))
5591       write (iout,*) "SCCOR parameter file : ",&
5592         sccorname(:ilen(sccorname))
5593       write (iout,*) "Bond & inertia constant file    : ",&
5594         bondname(:ilen(bondname))
5595       write (iout,*) "Bending parameter file          : ",&
5596         thetname(:ilen(thetname))
5597       write (iout,*) "Rotamer parameter file          : ",&
5598         rotname(:ilen(rotname))
5599 !el----
5600 #ifndef CRYST_THETA
5601       write (iout,*) "Thetpdb parameter file          : ",&
5602         thetname_pdb(:ilen(thetname_pdb))
5603 #endif
5604 !el
5605       write (iout,*) "Threading database              : ",&
5606         patname(:ilen(patname))
5607       if (lentmp.ne.0) &
5608       write (iout,*)" DIRTMP                          : ",&
5609         tmpdir(:lentmp)
5610       write (iout,'(80(1h-))')
5611       endif
5612       return
5613       end subroutine openunits
5614 !-----------------------------------------------------------------------------
5615       subroutine readrst
5616
5617       use geometry_data, only: nres,dc
5618       use MD_data
5619 !      implicit real*8 (a-h,o-z)
5620 !      include 'DIMENSIONS'
5621 !      include 'COMMON.CHAIN'
5622 !      include 'COMMON.IOUNITS'
5623 !      include 'COMMON.MD'
5624 !el local variables
5625       integer ::i,j
5626 !     real(kind=8) :: var,ene
5627
5628       open(irest2,file=rest2name,status='unknown')
5629       read(irest2,*) totT,EK,potE,totE,t_bath
5630       totTafm=totT
5631 !      do i=1,2*nres
5632 ! AL 4/17/17: Now reading d_t(0,:) too
5633       do i=0,2*nres
5634          read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
5635       enddo
5636 !      do i=1,2*nres
5637 ! AL 4/17/17: Now reading d_c(0,:) too
5638       do i=0,2*nres
5639          read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
5640       enddo
5641       if(usampl) then
5642              read (irest2,*) iset
5643       endif
5644       close(irest2)
5645       return
5646       end subroutine readrst
5647 !-----------------------------------------------------------------------------
5648       subroutine read_fragments
5649
5650       use energy_data
5651 !      use geometry
5652       use control_data, only:out1file
5653       use MD_data
5654       use MPI_data
5655 !      implicit real*8 (a-h,o-z)
5656 !      include 'DIMENSIONS'
5657 #ifdef MPI
5658       include 'mpif.h'
5659 #endif
5660 !      include 'COMMON.SETUP'
5661 !      include 'COMMON.CHAIN'
5662 !      include 'COMMON.IOUNITS'
5663 !      include 'COMMON.MD'
5664 !      include 'COMMON.CONTROL'
5665 !el local variables
5666       integer :: i
5667 !     real(kind=8) :: var,ene
5668
5669       read(inp,*) nset,nfrag,npair,nfrag_back
5670
5671 !el from module energy
5672 !      if(.not.allocated(mset)) allocate(mset(nset))  !(maxprocs/20)
5673       if(.not.allocated(wfrag_back)) then
5674         allocate(wfrag_back(3,nfrag_back,nset)) !(3,maxfrag_back,maxprocs/20)
5675         allocate(ifrag_back(3,nfrag_back,nset)) !(3,maxfrag_back,maxprocs/20)
5676
5677         allocate(qinfrag(nfrag,nset),wfrag(nfrag,nset)) !(50,maxprocs/20)
5678         allocate(ifrag(2,nfrag,nset))  !(2,50,maxprocs/20)
5679
5680         allocate(qinpair(npair,nset),wpair(npair,nset)) !(100,maxprocs/20)
5681         allocate(ipair(2,npair,nset))  !(2,100,maxprocs/20)
5682       endif
5683
5684       if(me.eq.king.or..not.out1file) &
5685        write(iout,*) "nset",nset," nfrag",nfrag," npair",npair,&
5686         " nfrag_back",nfrag_back
5687       do iset=1,nset
5688          read(inp,*) mset(iset)
5689        do i=1,nfrag
5690          read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset),&
5691            qinfrag(i,iset)
5692          if(me.eq.king.or..not.out1file) &
5693           write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset),&
5694            ifrag(2,i,iset), qinfrag(i,iset)
5695        enddo
5696        do i=1,npair
5697         read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset),&
5698           qinpair(i,iset)
5699         if(me.eq.king.or..not.out1file) &
5700          write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset),&
5701           ipair(2,i,iset), qinpair(i,iset)
5702        enddo
5703        do i=1,nfrag_back
5704         read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset),&
5705            wfrag_back(3,i,iset),&
5706            ifrag_back(1,i,iset),ifrag_back(2,i,iset)
5707         if(me.eq.king.or..not.out1file) &
5708          write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset),&
5709          wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset)
5710        enddo
5711       enddo
5712       return
5713       end subroutine read_fragments
5714 !-----------------------------------------------------------------------------
5715 ! shift.F       io_csa
5716 !-----------------------------------------------------------------------------
5717       subroutine csa_read
5718
5719       use csa_data
5720 !      implicit real*8 (a-h,o-z)
5721 !      include 'DIMENSIONS'
5722 !      include 'COMMON.CSA'
5723 !      include 'COMMON.BANK'
5724 !      include 'COMMON.IOUNITS'
5725 !el local variables
5726 !     integer :: ntf,ik,iw_pdb
5727 !     real(kind=8) :: var,ene
5728
5729       open(icsa_in,file=csa_in,status="old",err=100)
5730        read(icsa_in,*) nconf
5731        read(icsa_in,*) jstart,jend
5732        read(icsa_in,*) nstmax
5733        read(icsa_in,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5734        read(icsa_in,*) nran0,nran1,irr
5735        read(icsa_in,*) nseed
5736        read(icsa_in,*) ntotal,cut1,cut2
5737        read(icsa_in,*) estop
5738        read(icsa_in,*) icmax,irestart
5739        read(icsa_in,*) ntbankm,dele,difcut
5740        read(icsa_in,*) iref,rmscut,pnccut
5741        read(icsa_in,*) ndiff
5742       close(icsa_in)
5743
5744       return
5745
5746  100  continue
5747       return
5748       end subroutine csa_read
5749 !-----------------------------------------------------------------------------
5750       subroutine initial_write
5751
5752       use csa_data
5753 !      implicit real*8 (a-h,o-z)
5754 !      include 'DIMENSIONS'
5755 !      include 'COMMON.CSA'
5756 !      include 'COMMON.BANK'
5757 !      include 'COMMON.IOUNITS'
5758 !el local variables
5759 !     integer :: ntf,ik,iw_pdb
5760 !     real(kind=8) :: var,ene
5761
5762       open(icsa_seed,file=csa_seed,status="unknown")
5763        write(icsa_seed,*) "seed"
5764       close(31)
5765 #if defined(AIX) || defined(PGI)
5766        open(icsa_history,file=csa_history,status="unknown",&
5767         position="append")
5768 #else
5769        open(icsa_history,file=csa_history,status="unknown",&
5770         access="append")
5771 #endif
5772        write(icsa_history,*) nconf
5773        write(icsa_history,*) jstart,jend
5774        write(icsa_history,*) nstmax
5775        write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5776        write(icsa_history,*) nran0,nran1,irr
5777        write(icsa_history,*) nseed
5778        write(icsa_history,*) ntotal,cut1,cut2
5779        write(icsa_history,*) estop
5780        write(icsa_history,*) icmax,irestart
5781        write(icsa_history,*) ntbankm,dele,difcut
5782        write(icsa_history,*) iref,rmscut,pnccut
5783        write(icsa_history,*) ndiff
5784
5785        write(icsa_history,*)
5786       close(icsa_history)
5787
5788       open(icsa_bank1,file=csa_bank1,status="unknown")
5789        write(icsa_bank1,*) 0
5790       close(icsa_bank1)
5791
5792       return
5793       end subroutine initial_write
5794 !-----------------------------------------------------------------------------
5795       subroutine restart_write
5796
5797       use csa_data
5798 !      implicit real*8 (a-h,o-z)
5799 !      include 'DIMENSIONS'
5800 !      include 'COMMON.IOUNITS'
5801 !      include 'COMMON.CSA'
5802 !      include 'COMMON.BANK'
5803 !el local variables
5804 !     integer :: ntf,ik,iw_pdb
5805 !     real(kind=8) :: var,ene
5806
5807 #if defined(AIX) || defined(PGI)
5808        open(icsa_history,file=csa_history,position="append")
5809 #else
5810        open(icsa_history,file=csa_history,access="append")
5811 #endif
5812        write(icsa_history,*)
5813        write(icsa_history,*) "This is restart"
5814        write(icsa_history,*)
5815        write(icsa_history,*) nconf
5816        write(icsa_history,*) jstart,jend
5817        write(icsa_history,*) nstmax
5818        write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2
5819        write(icsa_history,*) nran0,nran1,irr
5820        write(icsa_history,*) nseed
5821        write(icsa_history,*) ntotal,cut1,cut2
5822        write(icsa_history,*) estop
5823        write(icsa_history,*) icmax,irestart
5824        write(icsa_history,*) ntbankm,dele,difcut
5825        write(icsa_history,*) iref,rmscut,pnccut
5826        write(icsa_history,*) ndiff
5827        write(icsa_history,*)
5828        write(icsa_history,*) "irestart is: ", irestart
5829
5830        write(icsa_history,*)
5831       close(icsa_history)
5832
5833       return
5834       end subroutine restart_write
5835 !-----------------------------------------------------------------------------
5836 ! test.F
5837 !-----------------------------------------------------------------------------
5838       subroutine write_pdb(npdb,titelloc,ee)
5839
5840 !      implicit real*8 (a-h,o-z)
5841 !      include 'DIMENSIONS'
5842 !      include 'COMMON.IOUNITS'
5843       character(len=50) :: titelloc1
5844       character*(*) :: titelloc
5845       character(len=3) :: zahl
5846       character(len=5) :: liczba5
5847       real(kind=8) :: ee
5848       integer :: npdb   !,ilen
5849 !el      external ilen
5850 !el local variables
5851       integer :: lenpre
5852 !     real(kind=8) :: var,ene
5853
5854       titelloc1=titelloc
5855       lenpre=ilen(prefix)
5856       if (npdb.lt.1000) then
5857        call numstr(npdb,zahl)
5858        open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
5859       else
5860         if (npdb.lt.10000) then
5861          write(liczba5,'(i1,i4)') 0,npdb
5862         else
5863          write(liczba5,'(i5)') npdb
5864         endif
5865         open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
5866       endif
5867       call pdbout(ee,titelloc1,ipdb)
5868       close(ipdb)
5869       return
5870       end subroutine write_pdb
5871 !-----------------------------------------------------------------------------
5872 ! thread.F
5873 !-----------------------------------------------------------------------------
5874       subroutine write_thread_summary
5875 ! Thread the sequence through a database of known structures
5876       use control_data, only: refstr
5877 !      use geometry
5878       use energy_data, only: n_ene_comp
5879       use compare_data
5880 !      implicit real*8 (a-h,o-z)
5881 !      include 'DIMENSIONS'
5882 #ifdef MPI
5883       use MPI_data      !include 'COMMON.INFO'
5884       include 'mpif.h'
5885 #endif
5886 !      include 'COMMON.CONTROL'
5887 !      include 'COMMON.CHAIN'
5888 !      include 'COMMON.DBASE'
5889 !      include 'COMMON.INTERACT'
5890 !      include 'COMMON.VAR'
5891 !      include 'COMMON.THREAD'
5892 !      include 'COMMON.FFIELD'
5893 !      include 'COMMON.SBRIDGE'
5894 !      include 'COMMON.HEADER'
5895 !      include 'COMMON.NAMES'
5896 !      include 'COMMON.IOUNITS'
5897 !      include 'COMMON.TIME1'
5898
5899       integer,dimension(maxthread) :: ip
5900       real(kind=8),dimension(0:n_ene) :: energia
5901 !el local variables
5902       integer :: i,j,ii,jj,ipj,ik,kk,ist
5903       real(kind=8) :: enet,etot,rmsnat,rms,frac,frac_nn
5904
5905       write (iout,'(30x,a/)') &
5906        '  *********** Summary threading statistics ************'
5907       write (iout,'(a)') 'Initial energies:'
5908       write (iout,'(a4,2x,a12,14a14,3a8)') &
5909        'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT',&
5910        'RMSnat','NatCONT','NNCONT','RMS'
5911 ! Energy sort patterns
5912       do i=1,nthread
5913         ip(i)=i
5914       enddo
5915       do i=1,nthread-1
5916         enet=ener(n_ene-1,ip(i))
5917         jj=i
5918         do j=i+1,nthread
5919           if (ener(n_ene-1,ip(j)).lt.enet) then
5920             jj=j
5921             enet=ener(n_ene-1,ip(j))
5922           endif
5923         enddo
5924         if (jj.ne.i) then
5925           ipj=ip(jj)
5926           ip(jj)=ip(i)
5927           ip(i)=ipj
5928         endif
5929       enddo
5930       do ik=1,nthread
5931         i=ip(ik)
5932         ii=ipatt(1,i)
5933         ist=nres_base(2,ii)+ipatt(2,i)
5934         do kk=1,n_ene_comp
5935           energia(i)=ener0(kk,i)
5936         enddo
5937         etot=ener0(n_ene_comp+1,i)
5938         rmsnat=ener0(n_ene_comp+2,i)
5939         rms=ener0(n_ene_comp+3,i)
5940         frac=ener0(n_ene_comp+4,i)
5941         frac_nn=ener0(n_ene_comp+5,i)
5942
5943         if (refstr) then
5944         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5945         i,str_nam(ii),ist+1,&
5946         (energia(print_order(kk)),kk=1,nprint_ene),&
5947         etot,rmsnat,frac,frac_nn,rms
5948         else
5949         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)') &
5950         i,str_nam(ii),ist+1,&
5951         (energia(print_order(kk)),kk=1,nprint_ene),etot
5952         endif
5953       enddo
5954       write (iout,'(//a)') 'Final energies:'
5955       write (iout,'(a4,2x,a12,17a14,3a8)') &
5956        'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT',&
5957        'RMSnat','NatCONT','NNCONT','RMS'
5958       do ik=1,nthread
5959         i=ip(ik)
5960         ii=ipatt(1,i)
5961         ist=nres_base(2,ii)+ipatt(2,i)
5962         do kk=1,n_ene_comp
5963           energia(kk)=ener(kk,ik)
5964         enddo
5965         etot=ener(n_ene_comp+1,i)
5966         rmsnat=ener(n_ene_comp+2,i)
5967         rms=ener(n_ene_comp+3,i)
5968         frac=ener(n_ene_comp+4,i)
5969         frac_nn=ener(n_ene_comp+5,i)
5970         write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
5971         i,str_nam(ii),ist+1,&
5972         (energia(print_order(kk)),kk=1,nprint_ene),&
5973         etot,rmsnat,frac,frac_nn,rms
5974       enddo
5975       write (iout,'(/a/)') 'IEXAM array:'
5976       write (iout,'(i5)') nexcl
5977       do i=1,nexcl
5978         write (iout,'(2i5)') iexam(1,i),iexam(2,i)
5979       enddo
5980       write (iout,'(/a,1pe14.4/a,1pe14.4/)') &
5981        'Max. time for threading step ',max_time_for_thread,&
5982        'Average time for threading step: ',ave_time_for_thread
5983       return
5984       end subroutine write_thread_summary
5985 !-----------------------------------------------------------------------------
5986       subroutine write_stat_thread(ithread,ipattern,ist)
5987
5988       use energy_data, only: n_ene_comp
5989       use compare_data
5990 !      implicit real*8 (a-h,o-z)
5991 !      include "DIMENSIONS"
5992 !      include "COMMON.CONTROL"
5993 !      include "COMMON.IOUNITS"
5994 !      include "COMMON.THREAD"
5995 !      include "COMMON.FFIELD"
5996 !      include "COMMON.DBASE"
5997 !      include "COMMON.NAMES"
5998       real(kind=8),dimension(0:n_ene) :: energia
5999 !el local variables
6000       integer :: ithread,ipattern,ist,i
6001       real(kind=8) :: etot,rmsnat,rms,frac,frac_nn
6002
6003 #if defined(AIX) || defined(PGI)
6004       open(istat,file=statname,position='append')
6005 #else
6006       open(istat,file=statname,access='append')
6007 #endif
6008       do i=1,n_ene_comp
6009         energia(i)=ener(i,ithread)
6010       enddo
6011       etot=ener(n_ene_comp+1,ithread)
6012       rmsnat=ener(n_ene_comp+2,ithread)
6013       rms=ener(n_ene_comp+3,ithread)
6014       frac=ener(n_ene_comp+4,ithread)
6015       frac_nn=ener(n_ene_comp+5,ithread)
6016       write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') &
6017         ithread,str_nam(ipattern),ist+1,&
6018         (energia(print_order(i)),i=1,nprint_ene),&
6019         etot,rmsnat,frac,frac_nn,rms
6020       close (istat)
6021       return
6022       end subroutine write_stat_thread
6023 !-----------------------------------------------------------------------------
6024 #endif
6025 !-----------------------------------------------------------------------------
6026       end module io_config