Merge branch 'lipid' of mmka.chem.univ.gda.pl:unres into lipid

[unres.git] / source / wham / src-NEWSC-NEWCORR / slices.F

diff --git a/source/wham/src-NEWSC-NEWCORR/slices.F b/source/wham/src-NEWSC-NEWCORR/slices.F
new file mode 100644 (file)
index 0000000..b22ea13
--- /dev/null
+++ b/source/wham/src-NEWSC-NEWCORR/slices.F
@@ -0,0 +1,80 @@
+      subroutine set_slices(is,ie,ts,te,iR,ib,iparm)
+      implicit none
+      include 'DIMENSIONS'
+      include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.PROTFILES'
+      include 'COMMON.OBCINKA'
+      include 'COMMON.PROT'
+      integer islice,iR,ib,iparm
+      integer is(MaxSlice),ie(MaxSlice),nrec_slice
+      double precision ts(MaxSlice),te(MaxSlice),time_slice
+
+      do islice=1,nslice
+        if (time_end_collect(iR,ib,iparm).ge.1.0d10) then
+          ts(islice)=time_start_collect(iR,ib,iparm)
+          te(islice)=time_end_collect(iR,ib,iparm)
+          nrec_slice=(rec_end(iR,ib,iparm)-
+     &       rec_start(iR,ib,iparm)+1)/nslice
+          is(islice)=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice
+          ie(islice)=rec_start(iR,ib,iparm)+islice*nrec_slice-1
+        else
+          time_slice=(time_end_collect(iR,ib,iparm)
+     &    -time_start_collect(iR,ib,iparm))/nslice
+          ts(islice)=time_start_collect(iR,ib,iparm)+(islice-1)*
+     &     time_slice
+          te(islice)=time_start_collect(iR,ib,iparm)+islice*time_slice
+          is(islice)=rec_start(iR,ib,iparm)
+          ie(islice)=rec_end(iR,ib,iparm)
+        endif
+      enddo
+
+      write (iout,*) "nrec_slice",nrec_slice," time_slice",time_slice
+      write (iout,*) "is",(is(islice),islice=1,nslice)
+      write (iout,*) "ie",(ie(islice),islice=1,nslice)
+      write (iout,*) "rec_start",
+     &  rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm)
+      write (iout,*) "ts",(ts(islice),islice=1,nslice)
+      write (iout,*) "te",(te(islice),islice=1,nslice)
+      write (iout,*) "time_start",
+     &  time_start_collect(iR,ib,iparm)," time_end",
+     &  time_end_collect(iR,ib,iparm)
+      call flush(iout)
+
+      return
+      end
+c-----------------------------------------------------------------------------
+      integer function slice(irecord,time,is,ie,ts,te)
+      implicit none
+      include 'DIMENSIONS'
+      include 'DIMENSIONS.ZSCOPT'
+      include 'DIMENSIONS.FREE'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.PROTFILES'
+      include 'COMMON.OBCINKA'
+      include 'COMMON.PROT'
+      integer is(MaxSlice),ie(MaxSlice),nrec_slice
+      double precision ts(MaxSlice),te(MaxSlice),time_slice
+      integer i,ii,irecord
+      double precision time
+
+c      write (iout,*) "within slice nslice",nslice
+c      call flush(iout)
+      if (irecord.lt.is(1) .or. time.lt.ts(1)) then
+        ii=0
+      else
+        ii=1
+        do while (ii.le.nslice .and. 
+     &           (irecord.lt.is(ii) .or. irecord.gt.ie(ii) .or.
+     &           time.lt.ts(ii) .or. time.gt.te(ii)) ) 
+c          write (iout,*) "ii",ii,time,ts(ii)
+c          call flush(iout)
+          ii=ii+1
+        enddo
+      endif
+c      write (iout,*) "end: ii",ii
+c      call flush(iout)
+      slice=ii
+      return
+      end