source/wham/src-M/read_dist_constr.F

   1       subroutine read_dist_constr
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.FREE'
   5 #ifdef MPI
   6       include 'mpif.h'
   7 #endif
   8       include 'COMMON.CONTROL'
   9       include 'COMMON.CHAIN'
  10       include 'COMMON.IOUNITS'
  11       include 'COMMON.SBRIDGE'
  12       integer ifrag_(2,100),ipair_(2,100)
  13       double precision wfrag_(100),wpair_(100)
  14       character*500 controlcard
  15       logical lprn /.true./
  16       write (iout,*) "Calling read_dist_constr"
  17 C      write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
  18 C      call flush(iout)
  19       write(iout,*) "TU sie wywalam?"
  20       call card_concat(controlcard,.false.)
  21       write (iout,*) controlcard
  22       call flush(iout)
  23       call readi(controlcard,"NFRAG",nfrag_,0)
  24       call readi(controlcard,"NPAIR",npair_,0)
  25       call readi(controlcard,"NDIST",ndist_,0)
  26       call reada(controlcard,'DIST_CUT',dist_cut,5.0d0)
  27       call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0)
  28       call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0)
  29       call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0)
  30       call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0)
  31       write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_
  32       write (iout,*) "IFRAG"
  33       do i=1,nfrag_
  34         write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
  35       enddo
  36       write (iout,*) "IPAIR"
  37       do i=1,npair_
  38         write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
  39       enddo
  40       call flush(iout)
  41       do i=1,nfrag_
  42         if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
  43         if (ifrag_(2,i).gt.nstart_sup+nsup-1)
  44      &    ifrag_(2,i)=nstart_sup+nsup-1
  45 c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
  46         call flush(iout)
  47         if (wfrag_(i).gt.0.0d0) then
  48         do j=ifrag_(1,i),ifrag_(2,i)-1
  49           do k=j+1,ifrag_(2,i)
  50             write (iout,*) "j",j," k",k
  51             ddjk=dist(j,k)
  52             if (constr_dist.eq.1) then
  53               nhpb=nhpb+1
  54               ihpb(nhpb)=j
  55               jhpb(nhpb)=k
  56               dhpb(nhpb)=ddjk
  57               forcon(nhpb)=wfrag_(i)
  58             else if (constr_dist.eq.2) then
  59               if (ddjk.le.dist_cut) then
  60                 nhpb=nhpb+1
  61                 ihpb(nhpb)=j
  62                 jhpb(nhpb)=k
  63                 dhpb(nhpb)=ddjk
  64                 forcon(nhpb)=wfrag_(i)
  65               endif
  66             else
  67               nhpb=nhpb+1
  68               ihpb(nhpb)=j
  69               jhpb(nhpb)=k
  70               dhpb(nhpb)=ddjk
  71               forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2)
  72             endif
  73             if (lprn)
  74      &      write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
  75      &       nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
  76           enddo
  77         enddo
  78         endif
  79       enddo
  80       do i=1,npair_
  81         if (wpair_(i).gt.0.0d0) then
  82         ii = ipair_(1,i)
  83         jj = ipair_(2,i)
  84         if (ii.gt.jj) then
  85           itemp=ii
  86           ii=jj
  87           jj=itemp
  88         endif
  89         do j=ifrag_(1,ii),ifrag_(2,ii)
  90           do k=ifrag_(1,jj),ifrag_(2,jj)
  91             nhpb=nhpb+1
  92             ihpb(nhpb)=j
  93             jhpb(nhpb)=k
  94             forcon(nhpb)=wpair_(i)
  95             dhpb(nhpb)=dist(j,k)
  96             write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
  97      &       nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
  98           enddo
  99         enddo
 100         endif
 101       enddo
 102       do i=1,ndist_
 103         if (constr_dist.eq.11) then
 104         read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
 105      &     ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1)
 106         fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1)
 107 C        write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
 108 C     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
 109         else
 110         read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
 111         endif
 112         if (forcon(nhpb+1).gt.0.0d0) then
 113           nhpb=nhpb+1
 114           if (ibecarb(i).gt.0) then
 115             ihpb(i)=ihpb(i)+nres
 116             jhpb(i)=jhpb(i)+nres
 117           endif
 118           if (dhpb(nhpb).eq.0.0d0)
 119      &       dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
 120 C          dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
 121           write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
 122      &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
 123         endif
 124 C      endif
 125       enddo
 126       call hpb_partition
 127       call flush(iout)
 128       return
 129       end