projects / unres.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
unres Adam's changes
[unres.git] / source / unres / src-HCD-5D / geomout.F
diff --git a/source/unres/src-HCD-5D/geomout.F b/source/unres/src-HCD-5D/geomout.F
index 09ad28e..3dcde10 100644 (file)
--- a/source/unres/src-HCD-5D/geomout.F
+++ b/source/unres/src-HCD-5D/geomout.F
@@ -1,5 +1,5 @@
       subroutine pdbout(etot,tytul,iunit)
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
       include 'COMMON.CHAIN'
       include 'COMMON.INTERACT'
@@ -7,11 +7,22 @@
       include 'COMMON.IOUNITS'
       include 'COMMON.HEADER'
       include 'COMMON.SBRIDGE'
-      include 'COMMON.DISTFIT'
+      include 'COMMON.FRAG'
       include 'COMMON.MD'
+#ifdef FIVEDIAG
+       include 'COMMON.LAGRANGE.5diag'
+#else
+       include 'COMMON.LAGRANGE'
+#endif
       character*50 tytul
-      character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
-      dimension ica(maxres)
+      integer iunit
+      character*1 chainid(52) /'A','B','C','D','E','F','G','H','I','J',
+     & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
+     & 'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p',
+     & 'q','r','s','t','u','v','w','x','y','z'/
+      integer ica(maxres)
+      integer i,j,k,iti,itj,itk,itl,iatom,ichain,ires
+      double precision etot
       write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
 cmodel      write (iunit,'(a5,i6)') 'MODEL',1
       if (nhfrag.gt.0) then
@@ -82,8 +93,8 @@ cmodel      write (iunit,'(a5,i6)') 'MODEL',1
         do i=1,nss
          if (dyn_ss) then
           write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') 
-     &         'SSBOND',i,'CYS',idssb(i)-nnt+1,
-     &                    'CYS',jdssb(i)-nnt+1
+     &         'SSBOND',i,'CYS',iss(idssb(i))-nnt+1,
+     &                    'CYS',iss(jdssb(i))-nnt+1
          else
           write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') 
      &         'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
@@ -99,9 +110,10 @@ cmodel      write (iunit,'(a5,i6)') 'MODEL',1
         iti=itype(i)
         if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then
           ichain=ichain+1
+          if (ichain.gt.52) ichain=1
           ires=0
           write (iunit,'(a)') 'TER'
-        else
+        else if (iti.ne.ntyp1) then
         ires=ires+1
         iatom=iatom+1
         ica(i)=iatom
@@ -141,7 +153,7 @@ cmodel      write (iunit,'(a5,i6)') 'MODEL',1
       write (iunit,'(a6)') 'ENDMDL'     
   10  FORMAT ('ATOM',I7,'  CA  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
   20  FORMAT ('ATOM',I7,'  CB  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
-  30  FORMAT ('CONECT',8I5)
+  30  FORMAT ('CONECT',8I7)
       return
       end
 c------------------------------------------------------------------------------
@@ -159,6 +171,7 @@ C format.
       character*32 tytul,fd
       character*3 zahl
       character*6 res_num,pom,ucase
+      double precision etot
 #ifdef AIX
       call fdate_(fd)
 #elif (defined CRAY)
@@ -203,7 +216,7 @@ C format.
       end
 c------------------------------------------------------------------------
       subroutine intout
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
       include 'COMMON.IOUNITS'
       include 'COMMON.CHAIN'
@@ -213,12 +226,13 @@ c------------------------------------------------------------------------
       include 'COMMON.NAMES'
       include 'COMMON.GEO'
       include 'COMMON.TORSION'
+      integer i,iti
       write (iout,'(/a)') 'Geometry of the virtual chain.'
-      write (iout,'(7a)') '  Res  ','         d','     Theta',
+      write (iout,'(7a)') '  Res   ','         d','     Theta',
      & '       Phi','       Dsc','     Alpha','      Omega'
       do i=1,nres
        iti=itype(i)
-        write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
+        write (iout,'(a3,i5,6f10.3)') restyp(iti),i,vbld(i),
      &     rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
      &     rad2deg*omeg(i)
       enddo
@@ -226,7 +240,7 @@ c------------------------------------------------------------------------
       end
 c---------------------------------------------------------------------------
       subroutine briefout(it,ener)
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
       include 'COMMON.IOUNITS'
       include 'COMMON.CHAIN'
@@ -236,6 +250,7 @@ c---------------------------------------------------------------------------
       include 'COMMON.NAMES'
       include 'COMMON.GEO'
       include 'COMMON.SBRIDGE'
+      integer it,ener,i
 c     print '(a,i5)',intname,igeom
 #if defined(AIX) || defined(PGI) || defined(CRAY)
       open (igeom,file=intname,position='append')
@@ -274,7 +289,7 @@ c----------------------------------------------------------------
 #else
       subroutine cartoutx(time)
 #endif
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
       include 'COMMON.CHAIN'
       include 'COMMON.INTERACT'
@@ -282,8 +297,10 @@ c----------------------------------------------------------------
       include 'COMMON.IOUNITS'
       include 'COMMON.HEADER'
       include 'COMMON.SBRIDGE'
-      include 'COMMON.DISTFIT'
+      include 'COMMON.FRAG'
       include 'COMMON.MD'
+      include 'COMMON.QRESTR'
+      integer i,j,k
       double precision time
 #if defined(AIX) || defined(PGI) || defined(CRAY)
       open(icart,file=cartname,position="append")
@@ -310,7 +327,7 @@ c----------------------------------------------------------------
 c-----------------------------------------------------------------
 #ifndef NOXDR
       subroutine cartout(time)
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
 #ifdef MPI
       include 'mpif.h'
@@ -324,11 +341,13 @@ c-----------------------------------------------------------------
       include 'COMMON.IOUNITS'
       include 'COMMON.HEADER'
       include 'COMMON.SBRIDGE'
-      include 'COMMON.DISTFIT'
+      include 'COMMON.FRAG'
       include 'COMMON.MD'
+      include 'COMMON.QRESTR'
       double precision time
       integer iret,itmp
       real xcoord(3,maxres2+2),prec
+      integer i,j,ixdrf
 
 #ifdef AIX
       call xdrfopen_(ixdrf,cartname, "a", iret)
@@ -426,8 +445,9 @@ c-----------------------------------------------------------------
       include 'COMMON.IOUNITS'
       include 'COMMON.HEADER'
       include 'COMMON.SBRIDGE'
-      include 'COMMON.DISTFIT'
+      include 'COMMON.FRAG'
       include 'COMMON.MD'
+      include 'COMMON.QRESTR'
       include 'COMMON.REMD'
       include 'COMMON.SETUP'
       integer itime
@@ -450,7 +470,7 @@ c-----------------------------------------------------------------
 #endif
 #endif
        if (AFMlog.gt.0) then
-         if (refstr) then
+       if (refstr) then
          call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
           write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)')
      &          itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
@@ -464,14 +484,14 @@ C          print *,'A CHUJ',potEcomp(23)
      &           kinetic_T,t_bath,gyrate(),
      &           potEcomp(23),me
           format1="a114"
-         endif
+        endif
        else if (selfguide.gt.0) then
        distance=0.0
        do j=1,3
        distance=distance+(c(j,afmend)-c(j,afmbeg))**2
        enddo
        distance=dsqrt(distance)
-        if (refstr) then
+       if (refstr) then
          call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
           write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2,
      &    f9.3,i5,$)')
@@ -480,7 +500,7 @@ C          print *,'A CHUJ',potEcomp(23)
      &          distance,potEcomp(23),me
           format1="a133"
 C          print *,"CHUJOWO"
-        else
+         else
 C          print *,'A CHUJ',potEcomp(23)
           write (line1,'(i10,f15.2,8f12.3,i5,$)')
      &           itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
@@ -489,7 +509,7 @@ C          print *,'A CHUJ',potEcomp(23)
           format1="a114"
         endif
        else
-        if (refstr) then
+       if (refstr) then
          call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
           write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
      &          itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27),
@@ -501,8 +521,8 @@ C          print *,'A CHUJ',potEcomp(23)
      &           amax,kinetic_T,t_bath,gyrate(),me
           format1="a114"
         endif
-       endif
-       if(usampl.and.totT.gt.eq_time) then
+        endif
+        if(usampl.and.totT.gt.eq_time) then
            if (loc_qlike) then
            write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
      &      (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
@@ -517,25 +537,25 @@ C          print *,'A CHUJ',potEcomp(23)
            write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
      &             +21*nfrag_back
            endif
-       else
+        else
            format2="a001"
            line2=' '
-       endif
-       if (print_compon) then
+        endif
+        if (print_compon) then
           if(itime.eq.0) then
            write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
-     &                                                     ",100a12)"
+     &                                                     ",31a12)"
            write (istat,format) "#"," ",
      &      (ename(print_order(i)),i=1,nprint_ene)
           endif
           write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
-     &                                                     ",100f12.3)"
+     &                                                     ",31f12.3)"
           write (istat,format) line1,line2,
      &      (potEcomp(print_order(i)),i=1,nprint_ene)
-       else
+        else
           write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
           write (istat,format) line1,line2
-       endif
+        endif
 #if defined(AIX)
         call flush(istat)
 #else
@@ -545,10 +565,11 @@ C          print *,'A CHUJ',potEcomp(23)
       end
 c---------------------------------------------------------------  
       double precision function gyrate()
-      implicit real*8 (a-h,o-z)
+      implicit none
       include 'DIMENSIONS'
       include 'COMMON.INTERACT'
       include 'COMMON.CHAIN'
+      integer i,ii,j
       double precision cen(3),rg
 
       do j=1,3
UNRESPACK 3.x