source/cluster/unres/src/cxread.F

   1       subroutine cxread(icon,*)
   2       include 'DIMENSIONS'
   3       include 'sizesclu.dat'
   4       include 'COMMON.CONTROL'
   5       include 'COMMON.CHAIN'
   6       include 'COMMON.INTERACT'
   7       include 'COMMON.NAMES'
   8       include 'COMMON.IOUNITS'
   9       include 'COMMON.HEADER'
  10       include 'COMMON.SBRIDGE'
  11       include 'COMMON.VAR'
  12       include 'COMMON.GEO'
  13       include 'COMMON.CLUSTER'
  14       character*64 nazwa
  15       real*4 rtime,rpotE,ruconst,rt_bath,rprop(20)
  16       double precision time
  17       integer iret,itmp
  18       real xoord(3,maxres2+2),prec
  19       double precision cm(3)
  20       integer nstep
  21       integer ilen
  22       external ilen
  23       integer icon
  24
  25 c      print *,"is",is," ie",ie," isampl",isampl
  26       print *,nazwa
  27       nstep=0
  28       icon=0
  29       nprop=0
  30       nprop_prev=0
  31       do i=1,20
  32         rprop(i)=0.0d0
  33       enddo
  34
  35       DO IFILE = 1, NFILES
  36
  37       print *,"CXREAD: opening file ",
  38      &   cxfiles(ifile)(:ilen(cxfiles(ifile)))
  39       write (iout,*) "CXREAD: opening file ",
  40      &   cxfiles(ifile)(:ilen(cxfiles(ifile)))
  41 #if (defined(AIX) && !defined(JUBL))
  42       call xdrfopen_(ixdrf,cxfiles(ifile), "r", iret)
  43 #else
  44       call xdrfopen(ixdrf,cxfiles(ifile), "r", iret)
  45 #endif
  46       if (iret.eq.0) cycle
  47
  48       print *,"CXREAD: reading file ",
  49      &   cxfiles(ifile)(:ilen(cxfiles(ifile)))
  50       write(iout,*) "CXREAD: reading file ",
  51      &   cxfiles(ifile)(:ilen(cxfiles(ifile)))
  52
  53       do while (iret.gt.0)
  54
  55 #if (defined(AIX) && !defined(JUBL))
  56       call xdrffloat_(ixdrf, rtime, iret)
  57       call xdrffloat_(ixdrf, rpotE, iret)
  58 #ifdef DEBUG
  59       write (iout,*) "rtime",rtime," rpotE",rpotE," iret",iret
  60 #endif
  61       call flush(iout)
  62       call xdrffloat_(ixdrf, ruconst, iret)
  63 #ifdef NEWUNRES
  64        call xdrffloat(ixdrf, ruconst_back, iret)
  65 c       print *,"uconst_back",ruconst_back
  66 #endif
  67       call xdrffloat_(ixdrf, rt_bath, iret)
  68       call xdrfint_(ixdrf, nss, iret)
  69 #ifdef DEBUG
  70       write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss
  71 #endif
  72       do j=1,nss
  73         call xdrfint_(ixdrf, ihpb(j), iret)
  74         call xdrfint_(ixdrf, jhpb(j), iret)
  75       enddo
  76       call xdrfint_(ixdrf, nprop, iret)
  77       do i=1,nprop
  78         call xdrffloat_(ixdrf, rprop(i), iret)
  79       enddo
  80 #else
  81       call xdrffloat(ixdrf, rtime, iret)
  82       call xdrffloat(ixdrf, rpotE, iret)
  83 #ifdef DEBUG
  84       write (iout,*) "rtime",rtime," rpotE",rpotE," iret",iret
  85 #endif
  86       call flush(iout)
  87       call xdrffloat(ixdrf, ruconst, iret)
  88 #ifdef NEWUNRES
  89        call xdrffloat(ixdrf, ruconst_back, iret)
  90 c       print *,"uconst_back",ruconst_back
  91 #endif
  92       call xdrffloat(ixdrf, rt_bath, iret)
  93       call xdrfint(ixdrf, nss, iret)
  94 #ifdef DEBUG
  95       write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss
  96 #endif
  97       do j=1,nss
  98         call xdrfint(ixdrf, ihpb(j), iret)
  99         call xdrfint(ixdrf, jhpb(j), iret)
 100       enddo
 101       call xdrfint(ixdrf, nprop, iret)
 102 c      write (iout,*) "nprop",nprop
 103       if (it.gt.0 .and. nprop.ne.nprop_prev) then
 104         write (iout,*) "Warning previous nprop",nprop_prev,
 105      &   " current",nprop
 106         nprop=nprop_prev
 107       else
 108         nprop_prev=nprop
 109       endif
 110       do i=1,nprop
 111         call xdrffloat(ixdrf, rprop(i), iret)
 112       enddo
 113 #endif
 114       if (iret.eq.0) exit
 115 #ifdef DEBUG
 116        write (iout,*) rtime,rpotE,rt_bath,nss,
 117      &     (ihpb(j),jhpb(j),j=1,nss),(rprop(j),j=1,nprop)
 118        write (iout,*) "nprop",nprop
 119        call flush(iout)
 120 #endif
 121       prec=10000.0
 122
 123       itmp=0
 124 #if (defined(AIX) && !defined(JUBL))
 125       call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
 126 #else
 127       call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
 128 #endif
 129 #ifdef DEBUG
 130       write (iout,'(10f8.3)') ((xoord(j,i),j=1,3),i=1,itmp)
 131 #endif
 132       if (iret.eq.0) exit
 133       if (itmp .ne. nres + nct - nnt + 1) then
 134         write (iout,*) "Error: inconsistent sizes",itmp,nres+nct-nnt+1
 135         call flush(iout)
 136         exit
 137       endif
 138
 139       time=rtime
 140
 141       do i=1,3
 142         cm(i)=0.0d0
 143       enddo
 144
 145       do i=1,nres
 146         do j=1,3
 147           c(j,i)=xoord(j,i)
 148           cm(j)=cm(j)+c(j,i)
 149         enddo
 150       enddo
 151       do i=1,nct-nnt+1
 152         do j=1,3
 153           c(j,i+nres+nnt-1)=xoord(j,i+nres)
 154         enddo
 155       enddo
 156
 157       do i=1,3
 158         cm(i)=cm(i)/nres
 159       enddo
 160
 161       do i=1,nres
 162         do j=1,3
 163           c(j,i)=c(j,i)-cm(j)
 164         enddo
 165       enddo
 166       do i=1,nct-nnt+1
 167         do j=1,3
 168           c(j,i+nres+nnt-1)=c(j,i+nres+nnt-1)-cm(j)
 169         enddo
 170       enddo
 171
 172       nstep=nstep+1
 173
 174       if (nstep.gt.ie .or. rtime.gt.te) return
 175
 176       if((nstep.ge.is.or.rtime.ge.ts) .and. mod(nstep,isampl).eq.0)then
 177
 178         icon=icon+1
 179 #ifdef DEBUG
 180         write (iout,*) "conformation, record",nstep,icon
 181         write (iout,*) "pote",rpotE," time",rtime
 182 c        write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss
 183 c        write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4
 184         call flush(iout)
 185 #endif
 186         energy(icon)=rpotE
 187         totfree(icon)=rpotE
 188         rmstab(icon)=rmsdev
 189         nss_all(icon)=nss
 190         do k=1,nss
 191           ihpb_all(k,icon)=ihpb(k)
 192           jhpb_all(k,icon)=jhpb(k)
 193         enddo
 194         iscore(icon)=icon
 195         do k=1,2*nres
 196           do l=1,3
 197             allcart(l,k,icon)=c(l,k)
 198           enddo
 199         enddo
 200
 201 #ifdef DEBUG
 202         call int_from_cart(.true.,.false.)
 203         write (iout,*) "Storing conformation, record",icon
 204         write (iout,*) "Cartesian coordinates"
 205         write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
 206         write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
 207         write (iout,*) "Internal coordinates"
 208         write (iout,'(8f10.4)') (dist(k-1,k),k=nnt+1,nct)
 209         write (iout,'(8f10.4)') (dist(k,k+nres),k=nnt,nct)
 210         write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 211         write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 212         write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 213         write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 214         write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
 215 c        write (iout,'(8f10.5)') (rprop(j),j=1,nQ)
 216         write (iout,'(16i5)') iscor
 217         call flush(iout)
 218 #endif
 219       endif
 220
 221   112 continue
 222
 223       enddo
 224
 225 #if (defined(AIX) && !defined(JUBL))
 226       call xdrfclose_(ixdrf, iret)
 227 #else
 228       call xdrfclose(ixdrf, iret)
 229 #endif
 230       write (iout,*) nstep," conformations read so far file",
 231      &   cxfiles(ifile)(:ilen(cxfiles(ifile)))
 232       call flush(iout)
 233
 234       ENDDO ! IFILE
 235
 236       return
 237       end