source/wham/src-new/slices.F

   1       subroutine set_slices(is,ie,ts,te,iR,ib,iparm)
   2       implicit none
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'DIMENSIONS.FREE'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.PROTFILES'
   8       include 'COMMON.OBCINKA'
   9       include 'COMMON.PROT'
  10       integer islice,iR,ib,iparm
  11       integer is(MaxSlice),ie(MaxSlice),nrec_slice
  12       double precision ts(MaxSlice),te(MaxSlice),time_slice
  13
  14       do islice=1,nslice
  15         if (time_end_collect(iR,ib,iparm).ge.1.0d10) then
  16           ts(islice)=time_start_collect(iR,ib,iparm)
  17           te(islice)=time_end_collect(iR,ib,iparm)
  18           nrec_slice=(rec_end(iR,ib,iparm)-
  19      &       rec_start(iR,ib,iparm)+1)/nslice
  20           is(islice)=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice
  21           ie(islice)=rec_start(iR,ib,iparm)+islice*nrec_slice-1
  22         else
  23           time_slice=(time_end_collect(iR,ib,iparm)
  24      &    -time_start_collect(iR,ib,iparm))/nslice
  25           ts(islice)=time_start_collect(iR,ib,iparm)+(islice-1)*
  26      &     time_slice
  27           te(islice)=time_start_collect(iR,ib,iparm)+islice*time_slice
  28           is(islice)=rec_start(iR,ib,iparm)
  29           ie(islice)=rec_end(iR,ib,iparm)
  30         endif
  31       enddo
  32
  33       write (iout,*) "nrec_slice",nrec_slice," time_slice",time_slice
  34       write (iout,*) "is",(is(islice),islice=1,nslice)
  35       write (iout,*) "ie",(ie(islice),islice=1,nslice)
  36       write (iout,*) "rec_start",
  37      &  rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm)
  38       write (iout,*) "ts",(ts(islice),islice=1,nslice)
  39       write (iout,*) "te",(te(islice),islice=1,nslice)
  40       write (iout,*) "time_start",
  41      &  time_start_collect(iR,ib,iparm)," time_end",
  42      &  time_end_collect(iR,ib,iparm)
  43       call flush(iout)
  44
  45       return
  46       end
  47 c-----------------------------------------------------------------------------
  48       integer function slice(irecord,time,is,ie,ts,te)
  49       implicit none
  50       include 'DIMENSIONS'
  51       include 'DIMENSIONS.ZSCOPT'
  52       include 'DIMENSIONS.FREE'
  53       include 'COMMON.IOUNITS'
  54       include 'COMMON.PROTFILES'
  55       include 'COMMON.OBCINKA'
  56       include 'COMMON.PROT'
  57       integer is(MaxSlice),ie(MaxSlice),nrec_slice
  58       double precision ts(MaxSlice),te(MaxSlice),time_slice
  59       integer i,ii,irecord
  60       double precision time
  61
  62 c      write (iout,*) "within slice nslice",nslice
  63 c      call flush(iout)
  64       if (irecord.lt.is(1) .or. time.lt.ts(1)) then
  65         ii=0
  66       else
  67         ii=1
  68         do while (ii.le.nslice .and.
  69      &           (irecord.lt.is(ii) .or. irecord.gt.ie(ii) .or.
  70      &           time.lt.ts(ii) .or. time.gt.te(ii)) )
  71 c          write (iout,*) "ii",ii,time,ts(ii)
  72 c          call flush(iout)
  73           ii=ii+1
  74         enddo
  75       endif
  76 c      write (iout,*) "end: ii",ii
  77 c      call flush(iout)
  78       slice=ii
  79       return
  80       end