source/unres/src-HCD-5D/int_from_cart.F

   1       subroutine int_from_cart(lside,lprn)
   2       implicit none
   3       include 'DIMENSIONS'
   4 #ifdef MPI
   5       include "mpif.h"
   6 #endif
   7       include 'COMMON.LOCAL'
   8       include 'COMMON.VAR'
   9       include 'COMMON.CHAIN'
  10       include 'COMMON.INTERACT'
  11       include 'COMMON.IOUNITS'
  12       include 'COMMON.GEO'
  13       include 'COMMON.NAMES'
  14       include 'COMMON.CONTROL'
  15       include 'COMMON.SETUP'
  16       double precision dist,alpha,beta
  17       character*3 seq,atom,res
  18       character*80 card
  19       double precision sccor(3,50)
  20       integer rescode
  21       logical lside,lprn
  22       integer i,j,iti
  23       double precision di,cosfac2,sinfac2,cosfac,sinfac
  24 #ifdef MPI
  25       if(me.eq.king.or..not.out1file)then
  26 #endif
  27        if (lprn) then
  28         write (iout,'(/a)')
  29      &  'Internal coordinates calculated from crystal structure.'
  30         if (lside) then
  31           write (iout,'(8a)') '  Res  ','       dvb','     Theta',
  32      & '       Phi','    Dsc_id','       Dsc','     Alpha',
  33      & '     Omega'
  34         else
  35           write (iout,'(4a)') '  Res  ','       dvb','     Theta',
  36      & '       Phi'
  37         endif
  38        endif
  39 #ifdef MPI
  40       endif
  41 #endif
  42       do i=1,nres-1
  43         iti=itype(i)
  44         if (iti.ne.ntyp1 .and. itype(i+1).ne.ntyp1 .and.
  45      &      (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0)) then
  46           write (iout,'(a,i4)') 'Bad Cartesians for residue',i
  47 ctest          stop
  48         endif
  49         vbld(i+1)=dist(i,i+1)
  50         vbld_inv(i+1)=1.0d0/vbld(i+1)
  51 c        write (iout,*) "i",i+1," vbld",vbld(i+1)," vbld_inv",
  52 c     &      vbld_inv(i+1)
  53         if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1)
  54         if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1)
  55       enddo
  56 c      if (unres_pdb) then
  57 c        if (itype(1).eq.21) then
  58 c          theta(3)=90.0d0*deg2rad
  59 c          phi(4)=180.0d0*deg2rad
  60 c          vbld(2)=3.8d0
  61 c          vbld_inv(2)=1.0d0/vbld(2)
  62 c        endif
  63 c        if (itype(nres).eq.21) then
  64 c          theta(nres)=90.0d0*deg2rad
  65 c          phi(nres)=180.0d0*deg2rad
  66 c          vbld(nres)=3.8d0
  67 c          vbld_inv(nres)=1.0d0/vbld(2)
  68 c        endif
  69 c      endif
  70 c      print *,"A TU2"
  71       if (lside) then
  72         do i=2,nres-1
  73           do j=1,3
  74             c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i)
  75      &     +(c(j,i+1)-c(j,i))*vbld_inv(i+1))
  76           enddo
  77           iti=itype(i)
  78           di=dist(i,nres+i)
  79           vbld(i+nres)=di
  80           if (itype(i).ne.10) then
  81             vbld_inv(i+nres)=1.0d0/di
  82           else
  83             vbld_inv(i+nres)=0.0d0
  84           endif
  85           if (iti.ne.10) then
  86             alph(i)=alpha(nres+i,i,maxres2)
  87             omeg(i)=beta(nres+i,i,maxres2,i+1)
  88           endif
  89           if(me.eq.king.or..not.out1file)then
  90            if (lprn)
  91      &     write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i),
  92      &     rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i),
  93      &     rad2deg*alph(i),rad2deg*omeg(i)
  94           endif
  95         enddo
  96         if (lprn) then
  97            i=nres
  98            iti=itype(nres)
  99            write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i),
 100      &     rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i),
 101      &     rad2deg*alph(i),rad2deg*omeg(i)
 102         endif
 103       else if (lprn) then
 104         do i=2,nres
 105           iti=itype(i)
 106           if(me.eq.king.or..not.out1file)
 107      &     write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1),
 108      &     rad2deg*theta(i),rad2deg*phi(i)
 109         enddo
 110       endif
 111       return
 112       end
 113 c-------------------------------------------------------------------------------
 114       subroutine sc_loc_geom(lprn)
 115       implicit none
 116       include 'DIMENSIONS'
 117 #ifdef MPI
 118       include "mpif.h"
 119 #endif
 120       include 'COMMON.LOCAL'
 121       include 'COMMON.VAR'
 122       include 'COMMON.CHAIN'
 123       include 'COMMON.INTERACT'
 124       include 'COMMON.IOUNITS'
 125       include 'COMMON.GEO'
 126       include 'COMMON.NAMES'
 127       include 'COMMON.CONTROL'
 128       include 'COMMON.SETUP'
 129       double precision x_prime(3),y_prime(3),z_prime(3)
 130       logical lprn
 131       integer i,j,it
 132       double precision xx,yy,zz,cosfac,cosfac2,sinfac,sinfac2
 133       do i=1,nres-1
 134         do j=1,3
 135           dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i))
 136         enddo
 137 c        write (iout,*) "i",i," dc",(dc_norm(j,i),j=1,3),
 138 c     &    " vbld",vbld_inv(i+1)
 139       enddo
 140       do i=2,nres-1
 141         if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
 142           do j=1,3
 143             dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i))
 144           enddo
 145 c          write (iout,*) "i",i," dc",(dc_norm(j,i+nres),j=1,3),
 146 c     &    " vbld",vbld_inv(i+nres)
 147         else
 148           do j=1,3
 149             dc_norm(j,i+nres)=0.0d0
 150           enddo
 151         endif
 152       enddo
 153       do i=2,nres-1
 154         costtab(i+1) =dcos(theta(i+1))
 155         sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
 156         cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
 157         sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
 158         cosfac2=0.5d0/(1.0d0+costtab(i+1))
 159         cosfac=dsqrt(cosfac2)
 160         sinfac2=0.5d0/(1.0d0-costtab(i+1))
 161         sinfac=dsqrt(sinfac2)
 162         it=itype(i)
 163 c        write (iout,*) "i",i," costab",costtab(i+1),
 164 c     &    " sintab",sinttab(i+1)
 165 c        write (iout,*) "dc_norm_b",(dc_norm(j,i-1),j=1,3)
 166 c        write (iout,*) "dc_norm_s",(dc_norm(j,i+nres),j=1,3)
 167         if (it.ne.10 .and. itype(i).ne.ntyp1) then
 168 c
 169 C  Compute the axes of tghe local cartesian coordinates system; store in
 170 c   x_prime, y_prime and z_prime
 171 c
 172         do j=1,3
 173           x_prime(j) = 0.00
 174           y_prime(j) = 0.00
 175           z_prime(j) = 0.00
 176         enddo
 177         do j = 1,3
 178           x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
 179           y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
 180         enddo
 181 c        write (iout,*) "x_prime",(x_prime(j),j=1,3)
 182 c        write (iout,*) "y_prime",(y_prime(j),j=1,3)
 183         call vecpr(x_prime,y_prime,z_prime)
 184 c        write (iout,*) "z_prime",(z_prime(j),j=1,3)
 185 c
 186 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
 187 C to local coordinate system. Store in xx, yy, zz.
 188 c
 189         xx=0.0d0
 190         yy=0.0d0
 191         zz=0.0d0
 192         do j = 1,3
 193           xx = xx + x_prime(j)*dc_norm(j,i+nres)
 194           yy = yy + y_prime(j)*dc_norm(j,i+nres)
 195           zz = zz + z_prime(j)*dc_norm(j,i+nres)
 196         enddo
 197
 198         xxref(i)=xx
 199         yyref(i)=yy
 200         zzref(i)=zz
 201         else
 202         xxref(i)=0.0d0
 203         yyref(i)=0.0d0
 204         zzref(i)=0.0d0
 205         endif
 206       enddo
 207       if (lprn) then
 208 #ifdef MPI
 209         if (me.eq.king.or..not.out1file) then
 210 #endif
 211         write (iout,*) "xxref,yyref,zzref"
 212         do i=2,nres
 213           write (iout,'(a3,i4,3f10.5)')
 214      &     restyp(itype(i)),i,xxref(i),yyref(i),zzref(i)
 215         enddo
 216 #ifdef MPI
 217         endif
 218 #endif
 219       endif
 220       return
 221       end
 222 c---------------------------------------------------------------------------
 223       subroutine sccenter(ires,nscat,sccor)
 224       implicit none
 225       include 'DIMENSIONS'
 226       include 'COMMON.CHAIN'
 227       integer i,j,ires,nscat
 228       double precision sccor(3,50)
 229       double precision sccmj
 230 c      write (2,*) "sccenter",ires,nscat
 231 c      call flush(2)
 232       do j=1,3
 233         sccmj=0.0D0
 234         do i=1,nscat
 235           sccmj=sccmj+sccor(j,i)
 236         enddo
 237         dc(j,ires)=sccmj/nscat
 238       enddo
 239       return
 240       end
 241 c---------------------------------------------------------------------------
 242       subroutine bond_regular
 243       implicit none
 244       include 'DIMENSIONS'
 245       include 'COMMON.VAR'
 246       include 'COMMON.LOCAL'
 247       include 'COMMON.INTERACT'
 248       include 'COMMON.CHAIN'
 249       integer i,i1,i2
 250       do i=1,nres-1
 251        vbld(i+1)=vbl
 252        vbld_inv(i+1)=vblinv
 253        vbld(i+1+nres)=dsc(iabs(itype(i+1)))
 254        vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1)))
 255 c       print *,vbld(i+1),vbld(i+1+nres)
 256       enddo
 257 c Adam 2/26/20 Alter virtual bonds for non-blocking end groups of each chain
 258       do i=1,nchain
 259         i1=chain_border(1,i)
 260         i2=chain_border(2,i)
 261         if (i1.gt.1) then
 262           vbld(i1)=vbld(i1)/2
 263           vbld_inv(i1)=vbld_inv(i1)*2
 264         endif
 265         if (i2.lt.nres) then
 266           vbld(i2+1)=vbld(i2+1)/2
 267           vbld_inv(i2+1)=vbld_inv(i2+1)*2
 268         endif
 269       enddo
 270       return
 271       end