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       write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
  17       call flush(iout)
  18       call card_concat(controlcard)
  19       call readi(controlcard,"NFRAG",nfrag_,0)
  20       call readi(controlcard,"NPAIR",npair_,0)
  21       call readi(controlcard,"NDIST",ndist_,0)
  22       call reada(controlcard,'DIST_CUT',dist_cut,5.0d0)
  23       call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0)
  24       call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0)
  25       call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0)
  26       call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0)
  27       write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_
  28       write (iout,*) "IFRAG"
  29       do i=1,nfrag_
  30         write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
  31       enddo
  32       write (iout,*) "IPAIR"
  33       do i=1,npair_
  34         write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
  35       enddo
  36       call flush(iout)
  37       do i=1,nfrag_
  38         if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
  39         if (ifrag_(2,i).gt.nstart_sup+nsup-1)
  40      &    ifrag_(2,i)=nstart_sup+nsup-1
  41 c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
  42         call flush(iout)
  43         if (wfrag_(i).gt.0.0d0) then
  44         do j=ifrag_(1,i),ifrag_(2,i)-1
  45           do k=j+1,ifrag_(2,i)
  46             write (iout,*) "j",j," k",k
  47             ddjk=dist(j,k)
  48             if (constr_dist.eq.1) then
  49               nhpb=nhpb+1
  50               ihpb(nhpb)=j
  51               jhpb(nhpb)=k
  52               dhpb(nhpb)=ddjk
  53               forcon(nhpb)=wfrag_(i)
  54             else if (constr_dist.eq.2) then
  55               if (ddjk.le.dist_cut) then
  56                 nhpb=nhpb+1
  57                 ihpb(nhpb)=j
  58                 jhpb(nhpb)=k
  59                 dhpb(nhpb)=ddjk
  60                 forcon(nhpb)=wfrag_(i)
  61               endif
  62             else
  63               nhpb=nhpb+1
  64               ihpb(nhpb)=j
  65               jhpb(nhpb)=k
  66               dhpb(nhpb)=ddjk
  67               forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2)
  68             endif
  69             if (lprn)
  70      &      write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
  71      &       nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
  72           enddo
  73         enddo
  74         endif
  75       enddo
  76       do i=1,npair_
  77         if (wpair_(i).gt.0.0d0) then
  78         ii = ipair_(1,i)
  79         jj = ipair_(2,i)
  80         if (ii.gt.jj) then
  81           itemp=ii
  82           ii=jj
  83           jj=itemp
  84         endif
  85         do j=ifrag_(1,ii),ifrag_(2,ii)
  86           do k=ifrag_(1,jj),ifrag_(2,jj)
  87             nhpb=nhpb+1
  88             ihpb(nhpb)=j
  89             jhpb(nhpb)=k
  90             forcon(nhpb)=wpair_(i)
  91             dhpb(nhpb)=dist(j,k)
  92             write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
  93      &       nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
  94           enddo
  95         enddo
  96         endif
  97       enddo
  98       do i=1,ndist_
  99         read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
 100         if (forcon(nhpb+1).gt.0.0d0) then
 101           nhpb=nhpb+1
 102           dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
 103           write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
 104      &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
 105         endif
 106       enddo
 107       call flush(iout)
 108       return
 109       end