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